读取指定目录下所有文本文件并复制内容到excel只执行一次循环就报错

duojinian

Option Explicit
' 读取指定目录下所有文本文件并复制内容到excel

Sub TestOpanAllFileAndCopy()

    Dim FS As Integer     ' 文件号
    Dim FName As String   ' 文件名
    Dim FPath As String   ' 路径
    Dim sht As Worksheet  ' 表
    Dim strTxt As String  ' 文本 【每行】
    Dim rowData As Long   ' 行
    Dim arrTemp           ' 数组



    FPath = "F:\FenBiShuJu"

    FName = Dir(FPath & "\*.txt")

    Do While FName <> ""
        FS = FreeFile

        Set sht = Worksheets.Add(after:=Worksheets(Worksheets.Count))
        sht.Name = FName
        rowData = 1
        Open FPath & "\" & FName For Input Access Read As #FS

        Do While Not EOF(FS)                ' 此处运行错误！ 此循环第一运行正常，第二次就异常【单步调试发现】
            Line Input #FS, strTxt
            arrTemp = Split(strTxt, Chr(9))
            sht.Cells(rowData, 1).Resize(1, UBound(arrTemp) + 1) = arrTemp
            rowData = rowData + 1

        Loop
    Close #FS
    FName = Dir
    Loop

End Sub