使用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