这将基于递归查看子文件夹中的文件来填充工作表。调用Recur-sub时遇到这个错误，搜索了类似的线程，但没有成功，试图弄清楚我在这里缺少了什么。据我所知，对Recur的调用与其参数相匹配。我是不是错过了一些显而易见的东西？谢谢
Public Wb As Workbook
Public Ws As Worksheet
Public CLP As String
''''''''''''''''''''''''''''''''''''''''''''''''''
Function GFold(Ttl, Dflt As String) As String
''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FDlog As FileDialog
Dim FStr As String
Set FDlog = Application.FileDialog(msoFileDialogFolderPicker)
With FDlog
.Title = Ttl
.AllowMultiSelect = False
.InitialFileName = Dflt
If .Show <> -1 Then GoTo NextCode
FStr = .SelectedItems(1)
End With
NextCode:
GFold = FStr
Set FDlog = Nothing
End Function
''''''''''''''''''''''''''''''
Sub CheckOffDocs()
''''''''''''''''''''''''''''''
Dim MyFSO, MyFld As Object
Dim Wb As Workbook
Dim Path, CLPath As String
' • Get folder path
Path = GFold("Select Parent Folder", Application.DefaultFilePath)
' • Check folder path
If Len(Path) = 0 Then
Exit Sub
End If
' • Create file sys obj
Set MyFSO = CreateObject("Scripting.FileSystemObject")
' • Get ahold of folder at path address
Set MyFld = MyFSO.getfolder(Path)
Set Wb = ActiveWorkbook
Set Ws = Wb.Sheets(1)
'• prompt clear checks input
If MsgBox("Clear existing inventory?", vbQuestion + vbYesNo) = vbYes Then
For c = 1 To 2
For r = 14 To 113
If Len(Ws.Cells(r, (c * 3) - 2).Value) > 1 Then
Ws.Cells(r, c * 3).ClearContents
End If
Next r
Next c
End If
'• pass folder to recur
Call Recur(MyFld)
'• clean up
Set MyFld = Nothing
Set MyFSO = Nothing
' • Set default location and prompt for save as info
SvName = CLPath & "L01 Contract File Checklist.xlsm"
SvName = Application.GetSaveAsFilename(InitialFileName:=SvName, fileFilter:="Excel files (*.xlsm), *.xlsm")
' • Check valid info
If Len(SvName) > 0 And InStr(SvName, "FALSE") = 0 And SvName <> False Then
If Left(UCase(Ws.Cells(1, 14).Value), 3) = "L01" Then Ws.Cells(1, 14).Value = "X"
Wb.SaveAs Filename:=SvName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Else
MsgBox "File not saved."
End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Recur(ByVal Fld As Object)
''''''''''''''''''''''''''''''''''''''''''''''''''
Dim r, c As Integer
Dim MySub, MyFIle As Object
'• Recursively loop all folders
For Each MySub In Fld.subfolders
Call Recur(MySub)
Next MySub
If InStr(UCase(Fld.Name), "CHECKLIST") > 0 Then
CLP = Fld.Path & ""
End If
For Each MyFIle In Fld.Files
For c = 1 To 2
For r = 14 To 113
'• Check for valid code row and match to filename
If Len(Ws.Cells(r, (c * 3) - 2).Value) > 1 And UCase(Left(MyFIle.Name, 3)) = UCase(Ws.Cells(r, (c * 3) - 2).Value, 3) Then
'• Mark "x" column
Ws.Cells(r, (c * 3)).Value = "X"
'• Bail out of loops after match
GoTo bail
End If
Next r
Next c
bail:
Next MyFIle
End Sub
请注意，在VBA中，您需要在声明中为每个变量指定数据类型，否则它们是Variants。
更改
Dim MySub, MyFIle As Object
至
Dim MySub As Object, MyFIle As Object
在其他地方也是如此。