根據數據中的特定字符將多個文本文件導入到Excel中，並在導入時添加其他數據

Question

我已經找到了將許多文本文件中的數據行導入到Excel工作表（https://stackoverflow.com/a/4941605/1892030，由Chris Neilsen回答）的答案。不過我也想做以下事情：

1. 在我想導入的有用數據前後有垃圾數據。我想要導入的數據行都以asterix（*）開頭。
2. 數據以逗號分隔，並且必須在導入到Excel中時進行解析。這可以通過編輯上述答案中的分析代碼來改變。
3. 在導入的每一行的末尾，我想添加一個額外的數據項，它是導入數據的文本文件的名稱（僅文件的名稱，不帶文件擴展名）。

克里斯回答說上面的工作真的很好，所以我想編輯代碼以允許我在上面的第1點和第3點的附加要求 - 但不知道如何。爲了完整起見，我複製下面早期答案的代碼。非常感謝。

Sub ReadFilesIntoActiveSheet() 

    Dim fso As FileSystemObject 
    Dim folder As folder 
    Dim file As file 
    Dim FileText As TextStream 
    Dim TextLine As String 
    Dim Items() As String 
    Dim i As Long 
    Dim cl As Range 

    ' Get a FileSystem object 
    Set fso = New FileSystemObject 

    ' get the directory you want 
    Set folder = fso.GetFolder("C:\#test") 

    ' set the starting point to write the data to 
    Set cl = ActiveSheet.Cells(1, 1) 

    ' Loop thru all files in the folder 
    For Each file In folder.Files 

     ' Open the file 
     Set FileText = file.OpenAsTextStream(ForReading) 

     ' Read the file one line at a time 
     Do While Not FileText.AtEndOfStream 

      TextLine = FileText.ReadLine 

      ' Parse the line into comma delimited pieces 
      Items = Split(TextLine, ",") 

      ' Put data on one row in active sheet 
      For i = 0 To UBound(Items) 
       cl.Offset(0, i).Value = Items(i) 
      Next 

      ' Move to next row 
      Set cl = cl.Offset(1, 0) 

     Loop 

     ' Clean up 
     FileText.Close 

    Next file 

    Set FileText = Nothing 
    Set file = Nothing 
    Set folder = Nothing 
    Set fso = Nothing 

End Sub 

Answer 1

我沒有做這一切爲你（我所期望的文件名需要整理，以適應你想要的格式），但在刪除此代碼，這將讓你開始...

' Read the file one line at a time 
    Do While Not FileText.AtEndOfStream 

     TextLine = FileText.ReadLine 

     ' Process lines which don't begin with Asterisk (*) 
     If Left(TextLine,1)<>"*" Then 

      ' This crudely appends the filename as if it were a column in the source file 
      TextLine = TextLine + "," + file.Name 

      ' Parse the line into comma delimited pieces 
      Items = Split(TextLine, ",") 

      ' Put data on one row in active sheet 
      For i = 0 To UBound(Items) 
       cl.Offset(0, i).Value = Items(i) 
      Next 

      ' Move to next row 
      Set cl = cl.Offset(1, 0) 
     End If 
    Loop