Question

我正在编写VBA代码，将文件添加到多个文件夹中，并将其添加到ZIP文件中。这个过程应该由一个预定的作业自动运行，我尝试添加一个参数来强制所有人＃34;是的。在Microsoft support中有一些常量，但如果我添加到我的代码中，我就没有预期的结果。代码如下

Public Sub ZipFolder(ZipFileName As Variant, _
                    FolderPath As Variant, _
                    Optional ByVal FileFilter As String, _
                    Optional ByVal Overwrite As Boolean = False)

Dim fso As Object, tf As Object
Dim strZIPHeader As String, sFile As String

On Error GoTo done
' create zip file header
strZIPHeader = Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, Chr(0))

    With CreateObject("Shell.Application")
        sFile = Dir(FolderPath, vbNormal)
        Do Until sFile = vbNullString
            .Namespace(ZipFileName).CopyHere FolderPath & sFile, **"&H10&"**
            sFile = Dir
        Loop
    End With


Set fso = Nothing
Set tf = Nothing
done:
    If Err.Number <> 0 Then MsgBox Err.Description, vbApplicationModal + vbInformation
End Sub

参数＆amp; H10＆amp;不起作用。我试过＆＃34;＆amp; 0X14＆amp;＆＃34;同样的结果。任何的想法？谢谢

Answer 1

你可以在这里研究这篇文章和完整的代码：

Zip and unzip files and folders with VBA the Windows Explorer way

您将看到，该文件将被覆盖，只需在继续之前将其删除：

    If FileSystemObject.FileExists(ZipFile) Then
        If Overwrite = True Then
            ' Delete an existing file.
            FileSystemObject.DeleteFile ZipFile, True
            ' At this point either the file is deleted or an error is raised.
        Else
            ZipBase = FileSystemObject.GetBaseName(ZipFile)
            ' Modify name of the zip file to be created to preserve an existing file:
            '   "Example.zip" -> "Example (2).zip", etc.
            Version = Version + 1
            Do
                Version = Version + 1
                ZipFile = FileSystemObject.BuildPath(ZipPath, ZipBase & Format(Version, " \(0\)") & ZipExtension)
            Loop Until FileSystemObject.FileExists(ZipFile) = False Or Version > MaxZipVersion
            If Version > MaxZipVersion Then
                ' Give up.
                Err.Raise ErrorPathFile, "Zip Create", "File could not be created."
            End If
        End If
    End If

copyhere并不尊重VBA中的覆盖参数

1 个答案: