Заархивируйте папку и файлы в папку - PullRequest
Новая
       17

Заархивируйте папку и файлы в папку

2 голосов
/ 16 мая 2019

Я заархивировал папку и содержимое с помощью Excel vba.eg: у меня есть папка с именем 2178 и 2 изображения в ней.

  1. 2178_photo.jpg
  2. 2178_poa.jpg

После архивирования мне понадобилось 3 файла в zip-папке.

  1. Folder Name
  2. 2178_photo.jpg
  3. 2178_poa.jpg

Но в текущей программе я получаю только 2 файла:

  1. 2178_photo.jpg
  2. 2178_poa.jpg
Sub NewZip(sPath) 'Create empty Zip File
    If Len(Dir(sPath)) > 0 Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1 
End Sub

Sub Zip_All_Files_in_Folder()
    Dim FileNameZip, FolderName
    Dim strDate As String, DefPath As String
    Dim oApp As Object DefPath = "D:\KYC\"
    FolderName = "d:\kyc\2178"     ' the zipping folder name '<< Change
    strDate = Format(Now, " dd-mmm-yy h-mm-ss")
    FileNameZip = "d:\kyc\2178.zip" ' to be zipped folder'DefPath & Range("A" & i).Value & ".zip"
    'Create empty Zip File
    NewZip (FileNameZip)
    Set oApp = CreateObject("Shell.Application")
    'Copy the files to the compressed folder
    oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items
    'Keep script waiting until Compressing is done
    On Error Resume Next
    Do Until oApp.Namespace(FileNameZip).items.count = _
       oApp.Namespace(FolderName).items.count
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop
    On Error GoTo 0
    MsgBox "ok " 
End Sub

Пожалуйста, помогите, мне нужно 3 имени в zip-файле.

...