循環錯誤通過目錄

Question

我希望有人能幫忙...我有下面的代碼，整天絕對有效。 直到16:10為止，現在突然決定接收運行時錯誤。 在Sheet1.Cells(lastRow, 1) = Data

Sub Loopthroughtxtdir()
    Dim Filename As String
    Dim Path As String

    Path = "C:\MK\MasterData\"
    Filename = Dir(Path & "*.txt")

    With ThisWorkbook.Sheets("Sheet1")
        Dim lastRow As Long
        lastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Do While Len(Filename) > 0
            Dim handle As Integer
            handle = FreeFile
            Open Path & Filename For Input As #handle
            Do Until EOF(handle)
                Line Input #handle, Data
                Sheet1.Cells(lastRow, 1) = Data
                lastRow = lastRow + 1
            Loop
            Close #handle
            Filename = Dir
        Loop
    End With

    MsgBox ("Import Complete")

End Sub

誰能幫忙。 我很困惑為什么這行得通。 一切都沒有改變，現在經過幾次測試已停止。

Answer 1

正如評論中指出的那樣，您的行已用完。 一種解決方案是進行測試，看看您是否剛打完最后一行，然后繼續使用新的工作表（顯然未經測試，但應有主旨）：

Sub Loopthroughtxtdir()
    Dim Filename As String
    Dim Path As String

    Path = "C:\MK\MasterData\"
    Filename = Dir$(Path & "*.txt")

    Dim currentSheet As Worksheet
    Set currentSheet = ThisWorkbook.Worksheets("Sheet1")
    With currentSheet
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    End With

    Do While Len(Filename) > 0
        Dim handle As Integer
        handle = FreeFile
        Open Path & Filename For Input As #handle
        Do Until EOF(handle)
            Line Input #handle, Data
            currentSheet.Cells(lastRow, 1) = Data
            lastRow = lastRow + 1
            If lastRow > currentSheet.Rows.Count Then
                Set currentSheet = ThisWorkbook.Worksheets.Add
                lastRow = 1
            End If
        Loop
        Close #handle
        Filename = Dir$
    Loop

    MsgBox ("Import Complete")
End Sub