[英]Loop error going through directory
我希望有人能帮忙...我有下面的代码,整天绝对有效。 直到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
谁能帮忙。 我很困惑为什么这行得通。 一切都没有改变,现在经过几次测试已停止。
正如评论中指出的那样,您的行已用完。 一种解决方案是进行测试,看看您是否刚打完最后一行,然后继续使用新的工作表(显然未经测试,但应有主旨):
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.