Option Explicit
 
'Const TextFolder As String = "D:\goo\data5"    'テキスト格納フォルダ
'Const BookFolder As String = "D:\goo\data7"    'excel Book格納フォルダ
Dim TextFolder As String
Dim BookFolder As String
Dim array_file() As String      'テキストファイル名の配列
Dim owb As Workbook             '出力ブック
Public Sub 全テキスト読込()
    Dim FSO As Object               'FileSystemObject
    Dim srcfolder As Object         'テキストファイルフォルダ
    Dim wfiles As Object            'テキストファイル一覧
    Dim wfile As Object             'テキストファイル
    Dim file_count As Long          'テキストファイルの件数
    Dim book_count As Long          'Bookの件数
    Dim book_no As Long             'ブック番号
    Dim sheet_no As Long            'シート番号
    Dim save_count As Variant       '退避領域
    Dim book_name As String         '出力ブック名
    Dim ret As Boolean              '戻り値
    ret = A(TextFolder, BookFolder)
    If ret = False Then Exit Sub
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set srcfolder = FSO.GetFolder(TextFolder)   'テキストファイル格納フォルダ情報取得
    Set wfiles = srcfolder.Files    'ファイル一覧取得
    file_count = 0
    '拡張子が.txtのファイルのみ取得し、array_fileに格納する
    For Each wfile In wfiles
        If LCase(Right(wfile.name, 4)) = ".txt" Then
            ReDim Preserve array_file(file_count)
            array_file(file_count) = wfile.name
            file_count = file_count + 1
        End If
    Next
    '出力するBookの件数を求める
    book_count = file_count \ 100
    'テキストファイル件数が100で割り切れないならBook件数に1加算
    If file_count Mod 100 > 0 Then
        book_count = book_count + 1
    End If
    'Book作成時のワークシートの数を退避
    save_count = Application.SheetsInNewWorkbook
    'Book作成時のワークシートの数を100に設定
    Application.SheetsInNewWorkbook = 100
    '1～Book件数まで繰り返す
    For book_no = 1 To book_count
        Set owb = Workbooks.Add
        'シート番号を1～100迄繰り返す
        For sheet_no = 1 To 100
            '１シート分を作成する
            ret = set_sheet(book_no, sheet_no)
            'テキストファイル数の上限を超えているなら打ち切る
            If ret = False Then Exit For
        Next
        'ブック名をBook+連番で出力する
        book_name = BookFolder & "\Book" & book_no & ".xlsx"
        owb.SaveAs Filename:=book_name
        owb.Close
    Next
    '退避したBook作成時のワークシートの数を戻す
    Application.SheetsInNewWorkbook = save_count
    MsgBox ("完了")
End Sub
 
'ブック番号(1～N)とシート番号(1～100)を元に、該当シートへテキストファイルを読み込む
Private Function set_sheet(ByVal book_no As Long, ByVal sheet_no As Long) As Boolean
    Dim i As Long
    Dim fname As String     'テキストファイル名（フルパス）
    Dim fileNo As Long      'ファイル番号
    Dim lno As Long         '行番号
    Dim text As String      '読み込んだテキスト
    Dim RE As Object        '正規表現オブジェクト
    Dim sname As String     'シート名
    Set RE = CreateObject("VBScript.RegExp")
    '1行が空白行か否かの判定用
    RE.Pattern = "^\s*$"
    RE.Global = True
    set_sheet = False
    'array_fileの何番目かを求める
    i = (book_no - 1) * 100 + sheet_no - 1
    '上限を超えているならFlaseで終了
    If i > UBound(array_file) Then Exit Function
    'テキストファイル名及びその拡張子を除いたものを取得
    fname = TextFolder & "\" & array_file(i)
    sname = array_file(i)
    sname = left(sname, Len(sname) - 4)
    fileNo = FreeFile
    Open fname For Input As #fileNo
    'ファイル終端まで読み込む
    lno = 0
    '1行空読み
    Line Input #fileNo, text
    Do Until EOF(fileNo)
        '1行読み込み
        Line Input #fileNo, text
        lno = lno + 1
        '空白行なら終了
        If RE.test(text) = True Then Exit Do
        'A列の該当行へ設定
        owb.Worksheets(sheet_no).Cells(lno, "A").Value = text
    Loop
    Close #fileNo
    'シート名を設定
    owb.Worksheets(sheet_no).name = sname
    '正常終了
    set_sheet = True
End Function
 
Private Function A(ByRef xFld1 As String, ByRef xFld2 As String) As Boolean
    A = False
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "対象フォルダー選択"
        If .Show = True Then
            xFld1 = .SelectedItems(1)
        Else
            Exit Function
        End If
    End With
 
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "保存先フォルダー選択"
        If .Show = True Then
            xFld2 = .SelectedItems(1)
        Else
            Exit Function
        End If
    End With
    A = True
End Function
 

T3B0aW9uIEV4cGxpY2l0CgonQ29uc3QgVGV4dEZvbGRlciBBcyBTdHJpbmcgPSAiRDpcZ29vXGRhdGE1IiAgICAn44OG44Kt44K544OI5qC857SN44OV44Kp44Or44OACidDb25zdCBCb29rRm9sZGVyIEFzIFN0cmluZyA9ICJEOlxnb29cZGF0YTciICAgICdleGNlbCBCb29r5qC857SN44OV44Kp44Or44OACkRpbSBUZXh0Rm9sZGVyIEFzIFN0cmluZwpEaW0gQm9va0ZvbGRlciBBcyBTdHJpbmcKRGltIGFycmF5X2ZpbGUoKSBBcyBTdHJpbmcgICAgICAn44OG44Kt44K544OI44OV44Kh44Kk44Or5ZCN44Gu6YWN5YiXCkRpbSBvd2IgQXMgV29ya2Jvb2sgICAgICAgICAgICAgJ+WHuuWKm+ODluODg+OCrwpQdWJsaWMgU3ViIOWFqOODhuOCreOCueODiOiqrei+vCgpCiAgICBEaW0gRlNPIEFzIE9iamVjdCAgICAgICAgICAgICAgICdGaWxlU3lzdGVtT2JqZWN0CiAgICBEaW0gc3JjZm9sZGVyIEFzIE9iamVjdCAgICAgICAgICfjg4bjgq3jgrnjg4jjg5XjgqHjgqTjg6vjg5Xjgqnjg6vjg4AKICAgIERpbSB3ZmlsZXMgQXMgT2JqZWN0ICAgICAgICAgICAgJ+ODhuOCreOCueODiOODleOCoeOCpOODq+S4gOimpwogICAgRGltIHdmaWxlIEFzIE9iamVjdCAgICAgICAgICAgICAn44OG44Kt44K544OI44OV44Kh44Kk44OrCiAgICBEaW0gZmlsZV9jb3VudCBBcyBMb25nICAgICAgICAgICfjg4bjgq3jgrnjg4jjg5XjgqHjgqTjg6vjga7ku7bmlbAKICAgIERpbSBib29rX2NvdW50IEFzIExvbmcgICAgICAgICAgJ0Jvb2vjga7ku7bmlbAKICAgIERpbSBib29rX25vIEFzIExvbmcgICAgICAgICAgICAgJ+ODluODg+OCr+eVquWPtwogICAgRGltIHNoZWV0X25vIEFzIExvbmcgICAgICAgICAgICAn44K344O844OI55Wq5Y+3CiAgICBEaW0gc2F2ZV9jb3VudCBBcyBWYXJpYW50ICAgICAgICfpgIDpgb/poJjln58KICAgIERpbSBib29rX25hbWUgQXMgU3RyaW5nICAgICAgICAgJ+WHuuWKm+ODluODg+OCr+WQjQogICAgRGltIHJldCBBcyBCb29sZWFuICAgICAgICAgICAgICAn5oi744KK5YCkCiAgICByZXQgPSBBKFRleHRGb2xkZXIsIEJvb2tGb2xkZXIpCiAgICBJZiByZXQgPSBGYWxzZSBUaGVuIEV4aXQgU3ViCiAgICBTZXQgRlNPID0gQ3JlYXRlT2JqZWN0KCJTY3JpcHRpbmcuRmlsZVN5c3RlbU9iamVjdCIpCiAgICBTZXQgc3JjZm9sZGVyID0gRlNPLkdldEZvbGRlcihUZXh0Rm9sZGVyKSAgICfjg4bjgq3jgrnjg4jjg5XjgqHjgqTjg6vmoLzntI3jg5Xjgqnjg6vjg4Dmg4XloLHlj5blvpcKICAgIFNldCB3ZmlsZXMgPSBzcmNmb2xkZXIuRmlsZXMgICAgJ+ODleOCoeOCpOODq+S4gOimp+WPluW+lwogICAgZmlsZV9jb3VudCA9IDAKICAgICfmi6HlvLXlrZDjgYwudHh044Gu44OV44Kh44Kk44Or44Gu44G/5Y+W5b6X44GX44CBYXJyYXlfZmlsZeOBq+agvOe0jeOBmeOCiwogICAgRm9yIEVhY2ggd2ZpbGUgSW4gd2ZpbGVzCiAgICAgICAgSWYgTENhc2UoUmlnaHQod2ZpbGUubmFtZSwgNCkpID0gIi50eHQiIFRoZW4KICAgICAgICAgICAgUmVEaW0gUHJlc2VydmUgYXJyYXlfZmlsZShmaWxlX2NvdW50KQogICAgICAgICAgICBhcnJheV9maWxlKGZpbGVfY291bnQpID0gd2ZpbGUubmFtZQogICAgICAgICAgICBmaWxlX2NvdW50ID0gZmlsZV9jb3VudCArIDEKICAgICAgICBFbmQgSWYKICAgIE5leHQKICAgICflh7rlipvjgZnjgotCb29r44Gu5Lu25pWw44KS5rGC44KB44KLCiAgICBib29rX2NvdW50ID0gZmlsZV9jb3VudCBcIDEwMAogICAgJ+ODhuOCreOCueODiOODleOCoeOCpOODq+S7tuaVsOOBjDEwMOOBp+WJsuOCiuWIh+OCjOOBquOBhOOBquOCiUJvb2vku7bmlbDjgasx5Yqg566XCiAgICBJZiBmaWxlX2NvdW50IE1vZCAxMDAgPiAwIFRoZW4KICAgICAgICBib29rX2NvdW50ID0gYm9va19jb3VudCArIDEKICAgIEVuZCBJZgogICAgJ0Jvb2vkvZzmiJDmmYLjga7jg6/jg7zjgq/jgrfjg7zjg4jjga7mlbDjgpLpgIDpgb8KICAgIHNhdmVfY291bnQgPSBBcHBsaWNhdGlvbi5TaGVldHNJbk5ld1dvcmtib29rCiAgICAnQm9va+S9nOaIkOaZguOBruODr+ODvOOCr+OCt+ODvOODiOOBruaVsOOCkjEwMOOBq+ioreWumgogICAgQXBwbGljYXRpb24uU2hlZXRzSW5OZXdXb3JrYm9vayA9IDEwMAogICAgJzHvvZ5Cb29r5Lu25pWw44G+44Gn57mw44KK6L+U44GZCiAgICBGb3IgYm9va19ubyA9IDEgVG8gYm9va19jb3VudAogICAgICAgIFNldCBvd2IgPSBXb3JrYm9va3MuQWRkCiAgICAgICAgJ+OCt+ODvOODiOeVquWPt+OCkjHvvZ4xMDDov4TnubDjgorov5TjgZkKICAgICAgICBGb3Igc2hlZXRfbm8gPSAxIFRvIDEwMAogICAgICAgICAgICAn77yR44K344O844OI5YiG44KS5L2c5oiQ44GZ44KLCiAgICAgICAgICAgIHJldCA9IHNldF9zaGVldChib29rX25vLCBzaGVldF9ubykKICAgICAgICAgICAgJ+ODhuOCreOCueODiOODleOCoeOCpOODq+aVsOOBruS4iumZkOOCkui2heOBiOOBpuOBhOOCi+OBquOCieaJk+OBoeWIh+OCiwogICAgICAgICAgICBJZiByZXQgPSBGYWxzZSBUaGVuIEV4aXQgRm9yCiAgICAgICAgTmV4dAogICAgICAgICfjg5bjg4Pjgq/lkI3jgpJCb29rK+mAo+eVquOBp+WHuuWKm+OBmeOCiwogICAgICAgIGJvb2tfbmFtZSA9IEJvb2tGb2xkZXIgJiAiXEJvb2siICYgYm9va19ubyAmICIueGxzeCIKICAgICAgICBvd2IuU2F2ZUFzIEZpbGVuYW1lOj1ib29rX25hbWUKICAgICAgICBvd2IuQ2xvc2UKICAgIE5leHQKICAgICfpgIDpgb/jgZfjgZ9Cb29r5L2c5oiQ5pmC44Gu44Ov44O844Kv44K344O844OI44Gu5pWw44KS5oi744GZCiAgICBBcHBsaWNhdGlvbi5TaGVldHNJbk5ld1dvcmtib29rID0gc2F2ZV9jb3VudAogICAgTXNnQm94ICgi5a6M5LqGIikKRW5kIFN1YgoKJ+ODluODg+OCr+eVquWPtygx772eTinjgajjgrfjg7zjg4jnlarlj7coMe+9njEwMCnjgpLlhYPjgavjgIHoqbLlvZPjgrfjg7zjg4jjgbjjg4bjgq3jgrnjg4jjg5XjgqHjgqTjg6vjgpLoqq3jgb/ovrzjgoAKUHJpdmF0ZSBGdW5jdGlvbiBzZXRfc2hlZXQoQnlWYWwgYm9va19ubyBBcyBMb25nLCBCeVZhbCBzaGVldF9ubyBBcyBMb25nKSBBcyBCb29sZWFuCiAgICBEaW0gaSBBcyBMb25nCiAgICBEaW0gZm5hbWUgQXMgU3RyaW5nICAgICAn44OG44Kt44K544OI44OV44Kh44Kk44Or5ZCN77yI44OV44Or44OR44K577yJCiAgICBEaW0gZmlsZU5vIEFzIExvbmcgICAgICAn44OV44Kh44Kk44Or55Wq5Y+3CiAgICBEaW0gbG5vIEFzIExvbmcgICAgICAgICAn6KGM55Wq5Y+3CiAgICBEaW0gdGV4dCBBcyBTdHJpbmcgICAgICAn6Kqt44G/6L6844KT44Gg44OG44Kt44K544OICiAgICBEaW0gUkUgQXMgT2JqZWN0ICAgICAgICAn5q2j6KaP6KGo54++44Kq44OW44K444Kn44Kv44OICiAgICBEaW0gc25hbWUgQXMgU3RyaW5nICAgICAn44K344O844OI5ZCNCiAgICBTZXQgUkUgPSBDcmVhdGVPYmplY3QoIlZCU2NyaXB0LlJlZ0V4cCIpCiAgICAnMeihjOOBjOepuueZveihjOOBi+WQpuOBi+OBruWIpOWumueUqAogICAgUkUuUGF0dGVybiA9ICJeXHMqJCIKICAgIFJFLkdsb2JhbCA9IFRydWUKICAgIHNldF9zaGVldCA9IEZhbHNlCiAgICAnYXJyYXlfZmlsZeOBruS9leeVquebruOBi+OCkuaxguOCgeOCiwogICAgaSA9IChib29rX25vIC0gMSkgKiAxMDAgKyBzaGVldF9ubyAtIDEKICAgICfkuIrpmZDjgpLotoXjgYjjgabjgYTjgovjgarjgolGbGFzZeOBp+e1guS6hgogICAgSWYgaSA+IFVCb3VuZChhcnJheV9maWxlKSBUaGVuIEV4aXQgRnVuY3Rpb24KICAgICfjg4bjgq3jgrnjg4jjg5XjgqHjgqTjg6vlkI3lj4rjgbPjgZ3jga7mi6HlvLXlrZDjgpLpmaTjgYTjgZ/jgoLjga7jgpLlj5blvpcKICAgIGZuYW1lID0gVGV4dEZvbGRlciAmICJcIiAmIGFycmF5X2ZpbGUoaSkKICAgIHNuYW1lID0gYXJyYXlfZmlsZShpKQogICAgc25hbWUgPSBsZWZ0KHNuYW1lLCBMZW4oc25hbWUpIC0gNCkKICAgIGZpbGVObyA9IEZyZWVGaWxlCiAgICBPcGVuIGZuYW1lIEZvciBJbnB1dCBBcyAjZmlsZU5vCiAgICAn44OV44Kh44Kk44Or57WC56uv44G+44Gn6Kqt44G/6L6844KACiAgICBsbm8gPSAwCiAgICAnMeihjOepuuiqreOBvwogICAgTGluZSBJbnB1dCAjZmlsZU5vLCB0ZXh0CiAgICBEbyBVbnRpbCBFT0YoZmlsZU5vKQogICAgICAgICcx6KGM6Kqt44G/6L6844G/CiAgICAgICAgTGluZSBJbnB1dCAjZmlsZU5vLCB0ZXh0CiAgICAgICAgbG5vID0gbG5vICsgMQogICAgICAgICfnqbrnmb3ooYzjgarjgonntYLkuoYKICAgICAgICBJZiBSRS50ZXN0KHRleHQpID0gVHJ1ZSBUaGVuIEV4aXQgRG8KICAgICAgICAnQeWIl+OBruipsuW9k+ihjOOBuOioreWumgogICAgICAgIG93Yi5Xb3Jrc2hlZXRzKHNoZWV0X25vKS5DZWxscyhsbm8sICJBIikuVmFsdWUgPSB0ZXh0CiAgICBMb29wCiAgICBDbG9zZSAjZmlsZU5vCiAgICAn44K344O844OI5ZCN44KS6Kit5a6aCiAgICBvd2IuV29ya3NoZWV0cyhzaGVldF9ubykubmFtZSA9IHNuYW1lCiAgICAn5q2j5bi457WC5LqGCiAgICBzZXRfc2hlZXQgPSBUcnVlCkVuZCBGdW5jdGlvbgoKUHJpdmF0ZSBGdW5jdGlvbiBBKEJ5UmVmIHhGbGQxIEFzIFN0cmluZywgQnlSZWYgeEZsZDIgQXMgU3RyaW5nKSBBcyBCb29sZWFuCiAgICBBID0gRmFsc2UKICAgIFdpdGggQXBwbGljYXRpb24uRmlsZURpYWxvZyhtc29GaWxlRGlhbG9nRm9sZGVyUGlja2VyKQogICAgICAgIC5UaXRsZSA9ICLlr77osaHjg5Xjgqnjg6vjg4Djg7zpgbjmip4iCiAgICAgICAgSWYgLlNob3cgPSBUcnVlIFRoZW4KICAgICAgICAgICAgeEZsZDEgPSAuU2VsZWN0ZWRJdGVtcygxKQogICAgICAgIEVsc2UKICAgICAgICAgICAgRXhpdCBGdW5jdGlvbgogICAgICAgIEVuZCBJZgogICAgRW5kIFdpdGgKCiAgICBXaXRoIEFwcGxpY2F0aW9uLkZpbGVEaWFsb2cobXNvRmlsZURpYWxvZ0ZvbGRlclBpY2tlcikKICAgICAgICAuVGl0bGUgPSAi5L+d5a2Y5YWI44OV44Kp44Or44OA44O86YG45oqeIgogICAgICAgIElmIC5TaG93ID0gVHJ1ZSBUaGVuCiAgICAgICAgICAgIHhGbGQyID0gLlNlbGVjdGVkSXRlbXMoMSkKICAgICAgICBFbHNlCiAgICAgICAgICAgIEV4aXQgRnVuY3Rpb24KICAgICAgICBFbmQgSWYKICAgIEVuZCBXaXRoCiAgICBBID0gVHJ1ZQpFbmQgRnVuY3Rpb24K