複数のテキストファイルをExcelにインポート

Question

1つのExcelワークシートに複数のテキストファイルをインポートする必要があります。私は以下のコードを試してみましたが、私が必要とする仕事の一部だけをしています。 すべてのテキストファイルは同じフォルダにあり、同じ名前です。したがって、テスト（1）、テスト（2）、...などです。

目標は次のとおりです。 すべてのテキストファイルを1つのExcelワークシートにインポートします。 テキストファイルを水平に貼り付ける必要があります：Excelのテキストファイルごとに1行。 次に、ファイルの内容をテキスト形式で貼り付ける必要があります。この問題の解決に私を助けてください。

Sub Files() 

Dim myfiles 
Dim i As Integer 

myfiles = Application.GetOpenFilename(filefilter:="TEXT Files (*.txt), *.txt", MultiSelect:=True) 
If Not IsEmpty(myfiles) Then 
    For i = LBound(myfiles) To UBound(myfiles) 
     With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myfiles(i), Destination:=range("A" & Rows.Count).End(xlUp).Offset(1, 0)) 
      .Name = "test" 
      .FieldNames = False 
      .RowNumbers = False 
      .FillAdjacentFormulas = False 
      .PreserveFormatting = True 
      .RefreshOnFileOpen = True 
      .RefreshStyle = xlInsertDeleteCells 
      .SavePassword = False 
      .SaveData = True 
      .AdjustColumnWidth = True 
      .RefreshPeriod = 0 
      .TextFilePromptOnRefresh = False 
      .TextFilePlatform = 437 
      .TextFileStartRow = 1 
      .TextFileParseType = xlDelimited 
      .TextFileTextQualifier = xlTextQualifierDoubleQuote 
      .TextFileConsecutiveDelimiter = True 
      .TextFileTabDelimiter = True 
      .TextFileSemicolonDelimiter = False 
      .TextFileCommaDelimiter = False 
      .TextFileSpaceDelimiter = True 
      .TextFileColumnDataTypes = Array(xlGeneralFormat) 
      .TextFileTrailingMinusNumbers = True 
      .Refresh BackgroundQuery:=False 
     End With 
    Next i 
Else 
    MsgBox "No File Selected" 
End If 

End Sub 

Answer 1

これはあなたのために行う必要があります。

Sub ReadFilesIntoActiveSheet() 

    Dim fso As FileSystemObject 
    Dim folder As folder 
    Dim file As file 
    Dim FileText As TextStream 
    Dim i As Long 
    Dim cl As Range 

    Set fso = New FileSystemObject 
    Set folder = fso.GetFolder("C:\your_path\") 

    Set cl = ActiveSheet.Cells(1, 1) 

    Application.ScreenUpdating = False 

    For Each file In folder.Files 

     Set FileText = file.OpenAsTextStream(ForReading) 
     cl.Value = file.Name 
     i = 1 

     Do While Not FileText.AtEndOfStream 
      cl.Offset(i, 0).Value = FileText.ReadLine 
      i = i + 1 
     Loop 

     FileText.Close 

     Set cl = cl.Offset(0, 1) 
    Next file 

    Application.ScreenUpdating = True 

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

End Sub