スキルアップ・問題解決なら、モーグにおまかせ！

ひとつのフォルダに約250個のテキストファイルがあります。
そのぞれのファイルは、データ量がまちまちで、少なくとも100行程度、多いものでは20000行程度のものがあります。
これらのテキストファイルを一括で同じエクセルシートに転記したいのです。
 
テキストデータには、下記のように入力されています。
0001 abcdefg
0002 hijklmnop
......以下0003，0004　と続く
 
当方のVBAでは
 
    Dim FilePath As String
    Dim fileContent As String
    Dim fileNumber As Integer
    Dim line As String
    Dim i As Long
 
Sub データ取り込み()
         
    i = 1
     
    FilePath = "C:\TEXT\ABC.TXT"
     
    ' ファイル番号を取得
    fileNumber = FreeFile
     
    ' テキストファイルを開く（読み取り専用モード）
    Open FilePath For Input As fileNumber
     
    ' ファイルの中身を1行ずつ読み込み
    Do Until EOF(fileNumber)
        Line Input #fileNumber, line ' 1行ずつ読み込む
        Cells(i, 1) = Mid(FilePath, 10, Len(FilePath) - 13)　 ’ファイル名を転記
        Cells(i, 2).Value = Left(line, 4)　　　　　　　　　　’番号を転記
        Cells(i, 3) = Right(line, Len(line) - 5)　　　　　　　'データ内容を転記
        i = i + 1 ' 次の行へ
    Loop
     
    ' ファイルを閉じる
    Close fileNumber
 
End Sub
 
と行った結果、確かにそのファイルだけはできましたが、他の約250個のテキストファイルを同様に実行するためのアイディアが浮かびません。どのようにしたらすべてのファイルが同様にデータ転記ができますでしょうかご教示願います。

PowerQueryでの処理に向いている様な気がするのですが、
その選択肢は無いですか？
 
＞20000行程度のものがあります。
その規模のファイルに対してご提示のコードを適用した場合、
時間が掛かりそうな気がするのですが、処理時間を計測したことありますか？

久しぶりの投稿者さんで気づくの遅れました。投稿歓迎です。
 
今の方針の延長線でする前提であれば、フォルダ内のファイルを繰り返し取得する
ことになりますね。
 
こちらのサイトの「即効テクニック」というコーナーがあり、
「フォルダ内のファイル一覧を取得する」
https://www.moug.net/tech/exvba/0060001.html
などという記事が参考になるかと思います。
（Dir関数を使う伝統的な方法のほか、FileSystemObjectを利用する方法もあります。
前者は学習して無駄になることはありませんが、ファイル名の文字コードの関連であったり、
最近では後者の方法がよく使われるかもしれません。速度的には前者が勝るかもしれませんが）
 
なお、貴兄の作成された方法では、一行一行をシートに書き込んでいますので、
やや時間がかかる印象です。（もちろん採り得ない方法ということではありません）
まとめてシートに書き込みができれば、速度向上の余地はありそうです。
 
# 取り急ぎ、方向性のみコメントします。
# 具体的なコードの議論をする用意（気持ち）は勿論あります。
# （お客さまに直ぐに帰られると、それはそれで他の回答者さんに迷惑がかかるので、言葉使いは慎重に）

半平太様、simple様ご回答ありがとうございます。
PowerQueryについてネットで確認したのですが、よくわかりませんでした。実力不足で申し訳ありません。
Dir()を使用してみたいと思い、即効テクニックを見てみました。
まだ十分に理解していませんが、これから少しずつ学習しようと思います。
また、データを１行ずつ転記する方法しか思い浮かばず、時間がかかっても仕方ないと思っていました。
処理時間は計測していませんが、すべてのファイルを転記する場合は、１時間程度はかかるかなと思っています。まとめて転記できる方法があれば使ってみたいですが。それをご教示願えませんか？
 
 

 (1)
 >まとめて転記できる方法
 標準的な方法は、動的配列（大雑把な言い方では、大きさを広げていける配列）に書き込み、
 それを最後に一括してシートに書き込み方式です。
  
 注意すべきは、最後の軸に沿ってしか拡大できないので、

 0001     0002       ・・・
 abcdefg  hijklmnop ・・・

Dim FSO         As Object
Dim targetSheet As Worksheet

Sub main()
    Const folder As String = "D:\MyDocuments\202609\test" 
                '対象ファイルが入っているフォルダのパス。'■修正必要
                '■尻尾に"\"は不要

    '(1)書き込み先シートの定義と初期設定
    Set targetSheet = ThisWorkbook.Worksheets("Sheet1") ' ■要確認
    With targetSheet
        .UsedRange.ClearContents    'いったん消去する   ■要注意
        .Columns("A:C").NumberFormatLocal = "@"
    End With

    '(2)ファイルを開いて、targetSheetに書き込む
    Dim f       As Variant
    Set FSO = CreateObject("Scripting.FileSystemObject")

    For Each f In FSO.GetFolder(folder).Files   '
        Call getData(f.Path)
    Next
    Set FSO = Nothing

    '(3)B列に読み込んだ文字列を、「区切り位置」機能を使ってB,C列に展開する
    Dim lastRow As Long, rng As Range
    With targetSheet
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        Set rng = .Range([B2], .Cells(lastRow, "B"))
        rng.TextToColumns Destination:=.Range("B2"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
                FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
    End With
End Sub

Function getData(fpath As String)
    Dim TextFile As Object, buf As String
    Dim buf2, buf3
    Dim basename As String
    Dim pos     As Long
    Dim n       As Long

    basename = FSO.GetBaseName(fpath)
    Set TextFile = FSO.OpenTextFile(fpath)
    buf = TextFile.ReadAll
    buf2 = Split(buf, vbCrLf)
    buf3 = Application.Transpose(buf2)

    If buf3(UBound(buf3, 1), 1) = "" Then  'データの最終行が改行で終わっている場合
        n = UBound(buf3, 1) - 1
    Else
        n = UBound(buf3, 1)
    End If

    'シートに書き込む
    With targetSheet
        pos = .Cells(Rows.Count, "B").End(xlUp).Row + 1
        .Cells(pos, "A").Resize(n, 1) = basename
        .Cells(pos, "B").Resize(n, 1) = buf3
    End With
    Set TextFile = Nothing
End Function

     Set rng = .Range([B2], .Cells(lastRow, "B")) 

     Set rng = .Range(.Range("B2"), .Cells(lastRow, "B"))

中間まとめ用にCollectionを使ってみました。
 
＞ Cells(i, 1) = Mid(FilePath, 10, Len(FilePath) - 13)　 ’ファイル名を転記
この意味がよく分からなかったので、そのままのロジックで処理しています。
 

    Dim FilePath As String
    Dim fileContent As String
    Dim fileNumber As Integer
    Dim line As String
    Dim i As Long
Sub データ取り込み()
    Dim COLL As Collection
    Dim folderPath As String
    Dim fileName As String
    Dim fileNameIncell As String
    Dim DATA(), DataAry
    Dim StartTime
    
    StartTime = Timer
    
    Set COLL = New Collection
    
    folderPath = "C:\TEXT"

    ' ファイル番号を取得
    fileNumber = FreeFile
    fileName = Dir(folderPath & "\*.TXT")
    
    Do While fileName <> ""
        FilePath = folderPath & "\" & fileName
        fileNameIncell = Mid(FilePath, 10, Len(FilePath) - 13)
        
        ' テキストファイルを開く（読み取り専用モード）
        Open FilePath For Input As fileNumber
        
        ' ファイルの中身を1行ずつ読み込み
        Do Until EOF(fileNumber)
            Line Input #fileNumber, line ' 1行ずつ読み込む
            COLL.Add Array(fileNameIncell, Left(line, 4), Right(line, Len(line) - 5))
        Loop
        
        fileName = Dir()
        Close fileNumber
    Loop
    
    i = 1
    ReDim DATA(1 To COLL.Count, 1 To 3)
    
    For Each DataAry In COLL
        DATA(i, 1) = DataAry(0)
        DATA(i, 2) = DataAry(1)
        DATA(i, 3) = DataAry(2)
        i = i + 1
    Next
    
    Columns("A:C").ClearContents
    Range("A1").Resize(UBound(DATA), 3) = DATA
    
    MsgBox (Timer - StartTime) & "秒"
End Sub

半平太様、simple様ご回答ありがとうございます。
これらを試してみます。
何か不明な点があった場合は、再度ご連絡します。

VBAの中で一つ一つのファイルを開く方法ももちろんありますが、作業ファイルを使っても良いのでしたら、
バッチを使って、複数ファイルを作業ファイルに1つに纏めてしまい
そのファイルをエクセルで読み込むのはどうでしょうか。
（対象となるファイルの文字に、機種依存文字を含んで居ない前提となります。）
 
BATファイルがある同一フォルダ内の txtファイルを連結するバッチ

@echo off
cd /d "%~dp0"

set "EXT=*.txt"
set "OUTPUT=combined.txt"

if exist "%OUTPUT%" del "%OUTPUT%"

for /f "delims=" %%f in ('dir /b /on "%EXT%"') do (
    type "%%f" >> "%OUTPUT%"
)

echo %EXT% タイプのファイルを %OUTPUT% に結合しました。
pause

Suzu様
 
アドバイスありがとうございます。
確かにバッチファイルを作成すると、まとめたテキストファイルがあっという間にできました。
このようなプログラムでもできるのかと感心してしまいました。
ただ、なかなか分かりにくいとは思いますが、エクセルのＡの列にファイル名も転記したいと思って、元々「Cells(i, 1) = Mid(FilePath, 10, Len(FilePath) - 13)」と記載しているのです。
Ｂ列には４桁の数字、Ｃ列にはその内容をエクセルに転記するというものです。
このバッチファイルにはファイル名の転記は無理でしょうか？

 yuiyui0618　さんへ
 >何か不明な点があった場合は、再度ご連絡します。
 そうして下さい。
 
なお、成功した場合も結果についてお知らせください。
できれば、処理時間も既に提示がありました方法で測定してください。
# なお、4桁のコードですが、２万件ですと４桁に収まりませんが重複ありということでしょうか？
ちなみに、今日明日は旅行していますので、返事が直ぐにはできません。あしからず。

yuiyui0618 さんの引用:
このバッチファイルにはファイル名の転記は無理でしょうか？

@echo off
cd /d "%~dp0"

set "EXT=*.txt"
set "OUTPUT=combined.txt"

if exist "%OUTPUT%" del "%OUTPUT%"

for /f "delims=" %%f in ('dir /b /on "%EXT%"') do (
    :: 各ファイルを1行ずつ読み込んで、末尾にファイル名を結合
    for /f "usebackq delims=" %%l in ("%%f") do (
        echo %%l %%f>> "%OUTPUT%"
    )
)

echo %EXT% タイプのファイルを %OUTPUT% に結合しました。
pause

返事が遅くなってすみません。
 
simple様
プログラムを使用したところ、わずか６秒で希望した通りでできました。ありがとうございます。
 
半平太様
プログラムを使用してみたのですが、エラーメッセージが出ました。内容は、
「アプリケーション定義またはオブジェクト定義のエラーです」です。
プログラム自体を見ると、
「Range（”A1”）．Resize（UBound（DATA),３）=DATA」
の部分が黄色く反転していました。この表現がエラーなのでしょうか？
 
Suzu様
プログラムの修正ありがとうございます。前のプログラムよりは時間がかかりましたが、それでも１５分程度で希望した通りになりました。
 
プログラムの内容については、時間がかかると思いますが、自分でもしっかり勉強したいと思います。皆さんありがとうございました。