VBA 运行时错误 1004 "Sorry we could find file.." 。VBA循环访问将所有数据编译到一个Excel工作表中的文件夹



我正在创建一个VBA代码,该代码循环访问相同文件(差异数据(的文件夹并将它们编译成一个Excel工作表。但是,有一个错误:

"运行时错误 1004:找不到 [文件]">

Sub LoopThroughFolderAllData()
Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range
Dim myPath As String
Dim FldrPicker As FileDialog

Set Wb = ThisWorkbook
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select Folder with IQC Data"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & ""
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings

'Target Path with Ending Extention
MyFile = Dir(myPath & "*.xls*")

Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Do While MyFile <> ""
Set Wb = Workbooks.Open(Filename:=myPath & MyFile)
Workbooks.Open (MyFile)
With Worksheets("All Data")
Rws = .Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(.Cells(2, 1), .Cells(Rws, 70))
Rng.Copy Wb.Worksheets("All Data").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
ActiveWorkbook.Close True
End With
MyFile = Dir()
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

错误发生在联机:

Workbooks.Open (MyFile)

任何帮助不胜感激!

修改Do While代码如下:

Do While MyFile <> ""
Set Wb = Workbooks.Open(Filename:=myPath & MyFile)
With Worksheets("All Data")
Rws = .Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(.Cells(2, 1), .Cells(Rws, 70))
Rng.Copy Wb.Worksheets("All Data").Cells(Rows.Count, 
"A").End(xlUp).Offset(1, 0)
wb.Close True
End With
MyFile = Dir()
Loop

我认为你不需要这条线

myPath = myPath

最新更新