首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
MCP广场
社区首页 >问答首页 >将文件夹对象传递给递归子对象时出现编译错误“参数数目错误或属性分配无效”

将文件夹对象传递给递归子对象时出现编译错误“参数数目错误或属性分配无效”
EN

Stack Overflow用户
提问于 2020-03-20 04:27:17
回答 1查看 114关注 0票数 0

这将根据递归查看子文件夹中的文件来填充工作表。在调用Recur sub时遇到这个错误,搜索了类似的线程,但没有运气,试图找出我在这里遗漏了什么。据我所知,对Recur的调用与其参数相匹配。我是不是漏掉了什么明显的东西?谢谢。

代码语言:javascript
运行
复制
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
EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2020-03-21 02:02:29

请注意,在VBA中,您需要在声明中指定每个变量的数据类型,否则它们就是Variant

变化

代码语言:javascript
运行
复制
Dim MySub, MyFIle As Object

代码语言:javascript
运行
复制
Dim MySub As Object, MyFIle As Object

在其他地方也是如此。

票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/60764555

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档