テキストファイルをエクセルに取り込むツール | エクセルマクロ(VBA)実践蔵(じっせんぐら)

トップ項目一覧

フォルダ内のテキストファイルをExcelのシートとして取り込むVBAツール

ひとつ前の記事で、バッチファイルを作成するマクロを載せたので、そのログがエクセルで取り込めるように、この記事では、フォルダ直下のテキストファイルをすべて開いて、エクセルに取り込んでいきたいと思います。各テキストファイルが1シートとなります。シート名は、テキストファイル名から拡張子を除いたものとなりますが、シートに使用できない記号[]があればそちらも削除されます。

エクセルの見た目

手順①

エクセルを起動したときに、上記セルB2が空欄の場合、エクセルファイルが格納されているフォルダへのパスが自動で入力されます。この部分のコードは、Visual Basic 画面のThisWorkbookにWorkbook_Openプロシージャとして記述しています。

テキストファイルが格納されているフォルダが異なる場合は、「フォルダ選択」ボタンから、テキストファイルが格納されているフォルダをダイアログから選択してください。このフォルダ選択のコードは、フォルダ参照-フォルダ選択ダイアログと同一のものを使用しています。

手順②

「テキストファイル一覧の取得」ボタンを押すと、FileListシートにフォルダ内のファイル一覧が表示されます。取り込みに不要なファイルが一覧にあれば、不要な行を削除して空欄ができないように詰めて削除してください。（マクロでは、空欄になるまで、テキストファイルを開いていくため、途中に空欄があると、テキストファイルの読み込みが止ります。）

このファイル一覧を取得するコードは、フォルダ内のファイル名取得（ファイル名一覧の作成）と同一のものを使用しています。

手順③

FileListのテキストファイル一覧の上から順に開いて、シートを右端に追加して、内容を転記していきます。

テキストファイルに使用できて、エクセルのシート名に使用できな文字である[]が使用されている場合は、削除されます。

「テキストファイルの読み込み」ボタンが押されたときに動作するマクロ(関数/プロシージャ)が下記になります。

FileListのテキストファイル一覧の上から順に空欄まで繰り返し、関数OpenTxtFileの引数にテキストファイルのパスを一つづつ順次渡しています。オプションとして、開いたファイルを削除するにチェックをつけている場合は、テキストファイルに対して、Killの命令が実行され、削除されます。

 
Sub テキストファイル取り込みBtn_Click() 
 
    Dim Rng As Range 
     
    Set Rng = ThisWorkbook.Worksheets("FileList").Range("A1") 
 
    Do While Not Rng.text = "" 
         
        OpenTxtFile(Rng.text) 
         
        '開いたファイルを削除 
        If KillTextChk = True Then 
            Kill Rng.text 
        End If 
         
        Set Rng = Rng.Offset(1, 0) 
         
    Loop 
 
End Sub 

上記から呼び出されているOpenTxtFileは、標準モジュールに記述していきます。

FileSystemObjectのGetFileNameを使用しているため、参照設定「Windows Script Host Object Model」が必要です。

参照設定の設定方法は、こちら。

 
Option Explicit 
'参照設定「Windows Script Host Object Model」 
 
'引数に渡されたテキストファイルを開いて、新規作成したシートに転記する。 
Function OpenTxtFile(Logfpath As String) 
     
    Dim objFSO As FileSystemObject 
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Dim filename As String 
     
    'ファイル名の取得 
    filename = objFSO.GetFileName(Logfpath) 
     
    Dim SheetName As String 
    '拡張子の削除 
    SheetName = Replace(filename, ".txt", "", , , vbTextCompare) 
    'ファイル名に使用できて、シート名に使用できない文字を削除[と] 
    SheetName = Replace(SheetName, "[", "", , , vbTextCompare) 
    SheetName = Replace(SheetName, "]", "", , , vbTextCompare) 
     
    '末尾にシートを追加 
    ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count) 
     
    ActiveSheet.Name = SheetName 
     
    Dim fn As Long 
    Dim txtLine As String 
    Dim rowNum As Long 
     
    fn = FreeFile 
     
    Open Logfpath For Input As #fn 
     
    Do While Not EOF(fn) 
        rowNum = rowNum + 1 
        Line Input #fn, txtLine 
        ActiveSheet.Cells(rowNum, 1).Value = txtLine 
    Loop 
     
    Close #fn 
     
End Function 

フォルダ配下のテキストファイルをすべてエクセルのシートとして取り込むツールのダウンロード

Windows PCにインストールされているExcelで起動してください。

下記からダウンロードしたエクセルファイルを起動し、コンテンツの有効化を行う。

マクロの有効化手順については、こちらも参考にしてください。

テキストファイルをすべてエクセルのシートとして取り込むツールのエクセルマクロ有効ブック(xlsm)のダウンロード