Question

下面的代码添加了一个名为＆＃34; Images＆＃34;的文件夹。进入我的zip文件。我不希望Images文件夹作为zip的子文件夹 - 我如何才能将Images文件夹的内容添加到zip文件的根目录？并且FolderToAdd & "*.*"无效。

Sub testing()
Dim ZipFile As String
Dim FolderToAdd As String
Dim objShell As Object
Dim varZipFile As Variant

ZipFile = "C:\ZipFile_Images\images.zip"
FolderToAdd = "C:\Images"

Set objShell = CreateObject("Shell.Application")
varZipFile = ZipFile

If Right$(FolderToAdd, 1) <> "\" Then
    FolderToAdd = FolderToAdd & "\"
End If

objShell.NameSpace(varZipFile).CopyHere (FolderToAdd)
End Sub

背景：我从一个将一个文件一次添加到给定zip文件的函数中提取此代码，但是当添加100个小JPEG文件时，这将花费大量时间。一次添加整个文件夹的速度提高了约50倍。

最终，我只想本地添加多个文件，因此我也可以使用其他代码段。

Answer 1

除了蒂姆·威廉姆斯的答案之外，以下是使我的代码工作的编辑 - 请注意注释行指示的两个非常小的变化。

Sub testing()
Dim ZipFile As String
'Dim FolderToAdd As String
Dim FolderToAdd
Dim objShell As Object
Dim varZipFile As Variant

ZipFile = "C:\ZipFile_Images\images.zip"
FolderToAdd = "C:\Images"

Set objShell = CreateObject("Shell.Application")
varZipFile = ZipFile

If Right$(FolderToAdd, 1) <> "\" Then
    FolderToAdd = FolderToAdd & "\"
End If

'objShell.NameSpace(varZipFile).CopyHere (FolderToAdd)
objShell.namespace(varZipFile).CopyHere objShell.namespace(FolderToAdd).Items
End Sub

Answer 2

来自Ron de Bruin的页面：http://www.rondebruin.nl/win/s7/win001.htm

你应该能够适应这一点。

关键部分是：

oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items

清单：

Sub Zip_All_Files_in_Folder_Browse()
    Dim FileNameZip, FolderName, oFolder
    Dim strDate As String, DefPath As String
    Dim oApp As Object

    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    strDate = Format(Now, " dd-mmm-yy h-mm-ss")
    FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"

    Set oApp = CreateObject("Shell.Application")

    'Browse to the folder
    Set oFolder = oApp.BrowseForFolder(0, "Select folder to Zip", 512)
    If Not oFolder Is Nothing Then
        'Create empty Zip File
        NewZip (FileNameZip)

        FolderName = oFolder.Self.Path
        If Right(FolderName, 1) <> "\" Then
            FolderName = FolderName & "\"
        End If

        '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 "You find the zipfile here: " & FileNameZip

    End If
End Sub

Answer 3

在maXbox，Delphi或ObjectPascal中：

 var ShellObj,varZipFile: OlEVariant;
     sourcefolder: string;

 varZipFile:= zipfile;
 Shellobj:= CreateOleObject('Shell.Application');

 Shellobj.namespace(varZipFile).CopyHere(Shellobj.namespace(sourcefolder).Items)

VBA .CopyHere - 将多个文件复制到ZIP文件？

3 个答案: