使用VBA從多個文本文件中只讀取一條記錄到Excel中

Question

我有一個文件夾中的多個txt文件，這些文件是製表符分隔的。這些文件中的每一個文件都有一個名爲EngagementId的列，它是相同的值，與記錄數無關。但是，它會更改每個txt文件，這是我想要捕獲的。

1. 我想獲取第一行的文件名。該GetFileNames（）的作品爲（在評論中指出）

---

Sub GetFileNames() 
    Dim sPath As String 
    Dim sFile As String 
    Dim iRow As Integer 
    Dim iCol As Integer 
    Dim splitFile As Variant 

    'specify directory to use - must end in "\" 
    sPath = ActiveWorkbook.Path 
    iRow = 0 
    sFile = Dir(sPath & "\Individual Reports\") 
    Do While sFile <> "" 
     iRow = iRow + 1 
     splitFile = Split(sFile, ".txt") 
     For iCol = 0 To UBound(splitFile) 
      Sheet1.Cells(iRow, iCol + 1) = splitFile(iCol) 
     Next iCol 
     sFile = Dir  ' Get next filename 
    Loop 
End Sub 

每個txt文件中有一列（這是在第13位在每個文本文件），稱爲「EngagementId」。我只想拉第一行「Engagement Id」，它來自第二行（因爲第一行包含標題）。

Sub Extractrec() 
    Dim filename As String, nextrow As Long, MyFolder As String 
    Dim MyFile As String, text As String, textline As String 

    MyFolder = ActiveWorkbook.Path 
    MyFile = Dir(MyFolder & "\Individual Reports\*.txt") 

    Do While MyFile <> "" 
     Open (MyFolder & MyFile) For Input As #1 
     Do Until EOF(1) 
      Line Input #1, LineFromFile 
      LineItems = Split(LineFromFile, "\t") 'second loop text is already stored 
                '-> see reset text 
      Sheet1.Cells(iRow, iCol + 2).Value = LineItems(13, 2) 
     Loop 
     Close #1 

    Loop 

Answer 1

既然你只需要每個文件的第二行，你並不需要循環，僅讀和丟棄拳頭線，然後閱讀並分割第二個：

Open (MyFolder & MyFile) For Input As #1 'MyFolder & MyFile won't be the correct name (probably should be MyFolder & "\Individual Reports\" & MyFile) 
    Line Input #1, LineFromFile 'line to discard 
    Line Input #1, LineFromFile 'line to use 
    LineItems = Split(LineFromFile, vbTab) 
    Sheet1.Cells(someplace).Value = LineItems(13) ' replace some place with the correct value that we don't know 
    Close #1 

Answer 2

使用ADODB.Recordset進行查詢會更通用。

---

Sub Example() 
    On Error Resume Next 
    Dim rs As Object, f As Object, conn As Object 
    Dim FolderPath As String, FileName As String, FilterString As String 
    FolderPath = "C:\Users\best buy\Downloads\stackoverfow\Sample Data File\" 
    FileName = "example.csv" 
    FilterString = "WHERE EngagementId = 20" 

    Set rs = getDataset(FolderPath, FileName, FilterString) 

    Do While Not rs.BOF And Not rs.EOF 
     Debug.Print rs.Fields("EngagementId") 
     Debug.Print rs.Fields("Company") 
     Debug.Print rs.Fields("City") 
     Debug.Print rs.Fields("State") 

     rs.MoveNext 
    Loop 

    Set conn = rs.ActiveConnection 
    rs.Close 
    conn.Close 
    Set rs = Nothing 
    Set conn = Nothing 
End Sub 

Function getDataset(FolderPath As String, FileName As String, FilterString As String) As Object 
    Dim conn As Object, rs As Object 
    Set conn = CreateObject("ADODB.Connection") 
    Set rs = CreateObject("ADODB.Recordset") 
    conn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FolderPath & ";" & _ 
      "Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;""") 
    rs.ActiveConnection = conn 
    rs.Source = "SELECT * FROM " & FileName & " " & FilterString 
    rs.Open 
    Set getDataset = rs 
End Function