Question

这是我第一次来这里。
我已经研究了好几个小时，却找不到答案。

我需要将一个文件夹中的单个文件复制到zip归档文件中（并非文件夹中的所有文件都像所有人一样）。
该代码可以很好地复制文件夹中的所有文件，但是当我放一个文件名时，它创建的zip文件不会在其中放置任何内容。

Private Sub Archive(sClientWB As String)
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim sArchiveDir As String
    sArchiveDir = Application.ActiveWorkbook.Path + cClientFolder + "Archive\"
    'Create folder if does not exist
    If Not fso.FolderExists(sArchiveDir) Then fso.CreateFolder (sArchiveDir)

    Dim vFileNameZip
    vFileNameZip = sArchiveDir + fso.GetBaseName(sClientWB) + ".zip"

    'create the empty zipfile
    Open vFileNameZip For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1

    Dim objApp As Object
    Set objApp = CreateObject("Shell.Application")

    'add file to zip archive
    objApp.Namespace(vFileNameZip).CopyHere sClientWB
    'nothing happens, the file is not added to the zip

    'when I execute this instead :
    objApp.Namespace(vFileNameZip).CopyHere objApp.Namespace(ActiveWorkbook.Path + cClientFolder).items
    'works fine, all the files in the folder get copied in the zip file

End Sub

我已明确验证sClientWB参数，并且该参数有效。
文件夹信任为
\ Gestion Clients \ Liste Clients.xlsm
\ Gestion Clients \ Clients \ LapFre20180908.xlsm
\ Gestion Clients \ Clients \ Archive \ LapFre20180908.zip
当前工作簿为\ Gestion Clients \ Liste Clients.xlsm

谢谢您的帮助。

Answer 1

如蒂姆·威廉姆斯（Tim Williams）在评论中所述，将sClientWB更改为Variant而不是字符串。

您还希望在.CopyHere语句后短暂暂停一下，以便有时间进行实际处理。这是我使用的代码：

这将获得当前zip存档中文件数量的计数

Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application")

Dim CurrentFileCount As Long
CurrentFileCount = ShellApp.NameSpace(Archive.ArchivePath & Archive.ArchiveName).Items.Count

这实际上将文件复制到存档中

ShellApp.NameSpace(Archive.ArchivePath & Archive.ArchiveName).CopyHere Archive.filePath & Archive.fileName

此循环一直等到文件计数增加为止，这告诉我它已完成压缩。

Do Until ShellApp.NameSpace(Archive.ArchivePath & Archive.ArchiveName).Items.Count > CurrentFileCount

  Dim Pause As Date

  Pause = DateAdd("s", 1, Now())
  While Now < Pause
    DoEvents
  Wend
Loop

请注意，我已经创建了一个类Archive，其中包含创建存档文件并填充所需的所有各种杂物。这是上面引用的位：

Const ARCHIVE_PATH As String = "Archive\"
Private pArchiveName As Variant                   'name of the zip file
Private pArchivePath As Variant                   'path to the zip file
Public Property Get ArchiveName() As Variant
  ArchiveName = pArchiveName
End Property
Public Property Let ArchiveName(ByVal Value As Variant)
  pArchiveName = Value
End Property
Public Property Get ArchivePath() As Variant
  ArchivePath = pArchivePath
End Property
Public Property Let ArchivePath(ByVal Value As Variant)
  pArchivePath = Value & ARCHIVE_PATH
End Property

Const ARCHIVE_PATH是因为我总是将存档放在“原始”数据所在的目录中。您可以根据需要进行调整。

将单个文件复制到zip存档中

1 个答案: