使用Excel VBA压缩文件会生成一个空存档

时间:2018-05-22 14:13:03

标签: excel vba excel-vba zip

我在使用Excel VBA压缩文件时遵循了Ron de Bruins tutorial。这是我使用的代码:

Private Sub ZipCSVFile()
  ' FileNameCSV contains the full path to the file
  FileNameZip = FileNameCSV & ".zip"
  NewZip (FileNameZip)
  Set objShell = CreateObject("Shell.Application")
  objShell.Namespace(FileNameZip).CopyHere FileNameCSV
  Application.Wait (Now + TimeValue("0:00:01"))
  Kill FileNameCSV
End Sub

Private Sub NewZip(sPath)
  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

当我运行此代码时,我将看到一个看似完全空的zip文件。

我发现一个奇怪的解决方法是将CSV存储在桌面上并使用.CopyHere而不是Dir(FileNameCSV)来调用FileNameCSV

增加超时没有用,也许值得一提的是,CSV文件在VBA脚本的早期阶段保存到了磁盘。

1 个答案:

答案 0 :(得分:0)

试试这个

    Private Sub ZipCSVFile()
      ' FileNameCSV contains the full path to the file
      FileNameZip = FileNameCSV & ".zip"
      NewZip (FileNameZip)
      Set objShell = CreateObject("Shell.Application")
      objShell.Namespace(FileNameZip).CopyHere FileNameCSV
    
      '---------------------------------------------------
      'Keep script waiting until Compressing is done
       On Error Resume Next
       Do Until objShell.Namespace(FileNameZip).items.Count = 1
           Application.Wait (Now + TimeValue("0:00:01"))
       Loop
       On Error GoTo 0
      '---------------------------------------------------        
    
      Kill FileNameCSV
    End Sub