将选定的文件复制到压缩文件夹：VBA中出现“找不到文件或没有读取权限”错误

我有一个代码，将所有选定的文件（信贷RonDeBruin的代码），虽然我修改了一些部分。 我的问题是，每次运行代码时都会popup如下错误：

这是我的代码：

Sub zipAllFiles() 'rondebruin <--- Credits to code Dim FileNameZip, FolderName Dim strDate As String, DefPath As String Dim oApp As Object Dim Fold As Range Dim ws As Worksheet Dim i As Integer, lastrow As Long DefPath = Application.DefaultFilePath If Right(DefPath, 1) <> "\" Then DefPath = DefPath & "\" End If Set ws = ThisWorkbook.Sheets(2) lastrow = ws.Cells(Rows.Count, 5).End(xlUp).Row '---> Files Directories strDate = Format(Now, " dd-mmm-yy h-mm-ss") FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip" 'Create empty Zip File NewZip (FileNameZip) 'E3:E&lastrow ---> Where the files directories are located. For Each Fold In ws.Range("E3:E" & lastrow) Set oApp = CreateObject("Shell.Application") FolderName = Fold.Value 'Copy the files to the compressed folder oApp.Namespace(FileNameZip).CopyHere FolderName Next Fold ws.Range("J1").Value = Dir(FileNameZip) '---> The directory of the Zipped file to Range(J1). Application.DisplayAlerts = False End Sub 

但是当我debugging它，它不会popup任何错误。 代码有问题吗？ 还是应该对文件夹或程序设置进行更改？ 请帮帮我 ：（

Answer 1

如果它在debugging时工作，但在不debugging的时候出错，那么代码的asynchronous性可能会有问题。 它似乎调用（开始）和VB执行其下一个语句时可能无法完成的外部进程。 所以你正在使用的库（Ron de Bruin的，你提到的，我没有这里）可能包含一个等待进程准备好的函数。

我也注意到：

 For Each Fold In ws.Range("E3:E" & lastrow) Set oApp = CreateObject("Shell.Application") 

你似乎在循环的每一次迭代中创build一个新的shell。 在循环之前不会创build一次就足够了？