VBA - Dir()的应用程序定义错误

时间:2017-10-31 22:58:28

标签: excel-vba vba excel

我在Excel VBA中遇到Dir()功能问题。当我运行以下代码时,代码会按预期重复,直到没有更多文件符合我的条件。一旦Dir()调用文件用完就会返回,我会收到Run-time error '1004': Application-defined or object-defined错误。我已经尝试了所有其他我能找到的答案,即使它们似乎也适用于我的情况。

Dim dataIter As Range
Dim outputIter As Range
Dim fileName As String
Dim wkbk As Workbook

fileName = Dir(path & "\" & "*.xlsm")
Do While Len(fileName) > 0
    Set wkbk = Workbooks.Open(path & "\" & fileName)
    Set dataIter = wkbk.Sheets(1).Range("A1")
    Do While dataIter.Address <> wkbk.Sheets(1).Range("TITLE").Address
        If dataIter.Value <> "" Then
            'Extract the data I need
            Set outputIter = outputIter.Offset(1)
        End If
        Set dataIter = dataIter.Offset(1)
    Loop
    wkbk.Close False
    fileName = Dir() 'Fails here
Loop

有效假设:

  1. 所有需要的工作表是每个工作簿中的第一个
  2. 所有工作表都有正确放置的“TITLE”命名范围
  3. 可能导致此问题的原因以及我该怎么做才能解决这个问题?

1 个答案:

答案 0 :(得分:1)

这是使用一些错误处理的快速修复,因为您的代码按预期运行直到结束。

Sub test()

    Dim dataIter As Range
    Dim outputIter As Range
    Dim fileName As String
    Dim wkbk As Workbook

    fileName = Dir(path & "\" & "*.xlsm")
    Do While Len(fileName) > 0
        Set wkbk = Workbooks.Open(path & "\" & fileName)
        Set dataIter = wkbk.Sheets(1).Range("A1")
        Do While dataIter.Address <> wkbk.Sheets(1).Range("TITLE").Address
            If dataIter.Value <> "" Then
                'Extract the data I need
                Set outputIter = outputIter.Offset(1)
            End If
            Set dataIter = dataIter.Offset(1)
        Loop
        wkbk.Close False
        On Error GoTo ErrHandler
        fileName = Dir() 'Fails here
        On Error GoTo 0
    Loop

    ' Any Remaining code

    Exit Sub
ErrHandler:
    If Err.Number = 1004 Then
        fileName = vbNullString
        Err.Clear
        Resume Next
    End If

End Sub