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

Question

我有一个代码，可以压缩所有选定的文件（信贷RonDeBruin的代码），虽然我修改了它的一些部分。我的问题是，每次我运行的代码它弹出这样的错误：

这里是我的代码：

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 

但是，当我调试它，它不会弹出任何错误。代码有问题吗？还是应该对文件夹或程序设置进行更改？请帮助我:(

Answer 1

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

我也注意到：

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

你似乎创建了一个新的shell，每次迭代循环都不会在循环之前创建一次吗？