未创建工作簿变量



我正在尝试浏览一些文件夹,其中有文件。从每个文件的相同范围中提取一些数据,并将其放在主电子表格的下一个空白行中。这在代码中被称为Wb。代码正在一个包含子文件夹的文件夹中循环。

Sub LoopFolders()
' Declaring variables
Dim myFolder As String
Dim mySubFolder As String
Dim myFile As String
Dim collSubFolders As New Collection
Dim myItem As Variant ' This means that excel will decide what kind of variable it is
Dim wbk As Workbook
Dim Wb As Workbook
Set Wb = ThisWorkbook
' set parent folder with trailing backslash
myFolder = "F:DocumentsAd-hocLoop"
'Retrieve first sub-folder
' * is the wildcard character
mySubFolder = Dir(myFolder & "*", vbDirectory)
Application.ScreenUpdating = False
'Do While Not mySubFolder = ""
Do While mySubFolder <> ""
Select Case mySubFolder
Case ".", ".." ' . refers to current folder, .. refers to the parent folder
' ignore current folder or parent folder
Case Else
' Add to collection called collSubFolders
'collSubFolders.Add Item:=mySubFolder, Key:=mySubFolder
collSubFolders.Add Item:=mySubFolder
End Select
' Get next entry
mySubFolder = Dir
Loop
' Loop through the collection
For Each myItem In collSubFolders
' Loop through Excel workbooks (with any extension) in subfolder
myFile = Dir(myFolder & myItem & "*.xls*")

Do While myFile <> ""
' Open workbook
DoEvents
Set wbk = Workbooks.Open(Filename:=myFolder & myItem & "" & myFile)
' Copy data from the opened workbook
' starting from row 2 and column 1 to row 3 and column 2 and copying it
ActiveSheet.Range(Cells(2, 1), Cells(3, 2)).Copy
---here the code breaks and an error 400 is shown----
' Close opened workbook without saving any changes
wbk.Close SaveChanges:=False
Wb.Activate
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
myFile = Dir
Loop
Next myItem
Application.ScreenUpdating = True
End Sub

我花了一些时间试图弄清楚为什么会出现这种情况。我发现,当我把鼠标悬停在wbk变量上时,即使我浏览了它,它也不会显示任何内容。文档确实打开了,但在那之后,当它被要求定位新活动文件上的范围时,它就无法处理了。有人知道为什么会这样吗?

另请注意:在文件夹中循环运行很好,我可以通过一步一步地查看它来看到这一点。这是我上面提到的部分,虽然看起来很简单,但似乎不起作用。

使用:

debug.print myFolder & myItem & "" & myFile

很可能你的路是错的。我的猜测是您有问题:myFile因为你首先执行:

myFile = Dir(myFolder & myItem & "*.xls*"),然后执行:

Filename:=myFolder & myItem & "" & myFile

翻译为:

Filename:=myFolder & myItem & "" & Dir(myFolder & myItem & "*.xls*")

最新更新