将文件夹和文件压缩到该文件夹​​

Question

我已经通过excel vba压缩了一个文件夹和内容。例如：我有一个名为2178的文件夹和2张图片。

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

压缩后，我需要3个压缩文件夹中的文件。

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

请帮助，我在zip文件中需要3个名字。