複数のテキストファイルからVBAを使用して1つのレコードのみを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」（2行目からのものです）（最初の行にはヘッダーが含まれているため）だけを取り出したいと思います。

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

あなただけの各ファイルの2行目を必要とするので、あなたが読んで、その後、ちょうど拳ラインを読み、捨てる、ループに必要な2つ目を分割しないでください：

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