マクロでフォルダ内の複数ファイル一括処理の事例13｜開く/読み込み/データ集約/コピー/ファイル数取得/印刷のVBAプログラム

f:id:gene320:20190107010435j:plain

エクセルマクロVBAを使ってフォルダ内の複数ファイル一括処理したい場合があります。

ウェブ上にはたくさんの情報がありますが、実際に使える事例を基にしたものが少ないのが現状です。

そこで、マクロVBAを使ってフォルダ内の複数ファイル一括処理するプログラムを事例をもとに紹介します。

フォルダ内の複数ファイルに対して
・開く
・読み込む
・ファイル数を取得する
・ファイルをコピーして移動する
・印刷する
・データを集約する

これらを網羅的に解説しています。ぜひ読んで実践してみてください。

フォルダ内の複数ファイルを繰り返し開く
- 事例1｜フォルダ内のエクセルファイルを全て開く、閉じる
- 事例2｜フォルダ内のテキストファイルを全て開く、閉じる
フォルダ内のファイル名を取得する
- 事例3｜フォルダ内のファイル名を全て取得する
- 事例4｜フォルダ内のエクセルファイル名を全て取得する
フォルダ内のファイル数をカウントする
- 事例5｜フォルダ内のファイル数をカウントする
フォルダ内のCSVやテキストファイルを読み込みを繰り返し行う
- 事例6｜フォルダ内のCSVファイルのみを全て読み込む
- 事例7｜フォルダ内のテキストファイルを全て読み込む
フォルダ内の複数ファイルを他のフォルダへコピーする
フォルダ内の複数ファイルを印刷する
- 事例11｜フォルダ内のエクセルファイルを全て印刷する
- 事例12｜フォルダ内のエクセルファイルを全てPDFにする
フォルダ内の複数ファイルのデータを一つにまとめる(集約する)
- 事例13｜フォルダ内のエクセルファイルを全て一つのエクセルにまとめる
- まとめたエクセルデータを集計する
マクロをさらに使いこなすためには
- まずは無料でマクロを勉強してみる
- エクセルマクロ関連のお勧め記事

フォルダ内の複数ファイルを繰り返し開く

事例1｜フォルダ内のエクセルファイルを全て開く、閉じる
事例2｜フォルダ内のテキストファイルを全て開く、閉じる

以下でプログラムの解説をします。

事例1｜フォルダ内のエクセルファイルを全て開く、閉じる

'事例1｜フォルダ内のエクセルファイルを全て開く、閉じる
Option Explicit
Sub OpenAllFiles()
        
    'ステップ1｜変数定義
    Dim path As String
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
   
    'ステップ2｜FileSystemObjectの変数設定
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
   
    'ステップ4｜指定フォルダ内のファイルを繰り返しを読み込む
    For Each mysubfile In mysubfiles
        
        'ステップ5｜ファイルを開く、閉じる
        'Like ["xls*"] はワイルドカード
        '"xls"、"xlsx"、"xlsm"を認識する
        If fs.GetExtensionName(mysubfile) Like ["xls*"] Then
        
            Workbooks.Open Filename:=mysubfile.path
            
            'ステップ6｜任意の処理を入れる
            MsgBox mysubfile.Name & "を開きました"
            
            'ステップ7｜ファイルを閉じる
            ActiveWorkbook.Close
        End If
    Next
   
End Sub

事例2｜フォルダ内のテキストファイルを全て開く、閉じる

'事例2｜フォルダ内のテキストファイルを全て開く、閉じる
Option Explicit
Sub OpenFilesOnlyText()
    
    Dim path As String
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
    Dim txt As TextStream
    
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
   
    For Each mysubfile In mysubfiles
             
        'ステップ5｜ファイル拡張子を取得し
        '拡張子txtだったら処理を行う
        If fs.GetExtensionName(mysubfile) = "txt" Then
            
            Set txt = fs.OpenTextFile(mysubfile)
            
            'ステップ6｜任意の処理を入れる
            MsgBox mysubfile.Name & "を開きました"
            
            'ステップ7｜ファイルを閉じる
            txt.Close
            
        End If
    Next
   
End Sub

フォルダ内のファイル名を取得する

事例3｜フォルダ内のファイル名を全て取得する
事例4｜フォルダ内のエクセルファイル名を全て取得する

以下でプログラムの解説をします。

事例3｜フォルダ内のファイル名を全て取得する

'事例3｜フォルダ内のファイル名を全て取得する
Option Explicit
Sub GetFilesName()
        
    'ステップ1｜変数定義
    Dim path As String
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
    Dim str As String
    
    'ステップ2｜FileSystemObjectの変数設定
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
    
    'ステップ4｜指定フォルダ内のファイルを繰り返しを読み込む
    For Each mysubfile In mysubfiles
        
        str = str & vbCrLf & mysubfile.Name
        
    Next
   
    MsgBox str
   
End Sub

事例4｜フォルダ内のエクセルファイル名を全て取得する

'事例4｜フォルダ内のエクセルファイル名を全て取得する
Option Explicit
Sub GetFileNameOnlyExcel()
    
    'ステップ1｜変数定義
    Dim path As String
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
    Dim str As String
    
    'ステップ2｜FileSystemObjectの変数設定
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
   
    'ステップ4｜指定フォルダ内のファイルを繰り返しを読み込む
    For Each mysubfile In mysubfiles
        
        'ステップ5｜ファイルを開く、閉じる
        'Like ["xls*"] はワイルドカード
        '"xls"、"xlsx"、"xlsm"を認識する
        If fs.GetExtensionName(mysubfile) Like ["xls*"] Then
        
            str = str & vbCrLf & mysubfile.Name
        
        End If
    Next
    
    MsgBox str
    
End Sub

フォルダ内のファイル数をカウントする

事例5｜フォルダ内のファイル数をカウントする

以下でプログラムの解説をします。

事例5｜フォルダ内のファイル数をカウントする

Option Explicit
'事例5｜フォルダ内のファイル数をカウントする
Sub CountFiles()
        
    'ステップ1｜変数定義
    Dim path As String
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
    Dim n As Long
    
    'ステップ2｜FileSystemObjectの変数設定
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
    
    'ステップ4｜指定フォルダ内のファイルを繰り返しを読み込む
    For Each mysubfile In mysubfiles
        
        n = n + 1
        
    Next
   
    MsgBox n
   
End Sub

フォルダ内のCSVやテキストファイルを読み込みを繰り返し行う

事例6｜フォルダ内のCSVファイルのみを全て読み込む
事例7｜フォルダ内のテキストファイルを全て読み込む

以下でプログラムの解説をします。

事例6｜フォルダ内のCSVファイルのみを全て読み込む

Option Explicit
'事例6｜フォルダ内のCSVファイルのみを全て読み込む
Sub ReadCSVFiles()
    
    Dim path As String
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
    Dim str As String, strs As String, str1 As String
    Dim k As String
    Dim i As Long
    
    Dim adoSt As Object
    Set adoSt = CreateObject("ADODB.Stream")
    
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
   
    For Each mysubfile In mysubfiles
             
        If fs.GetExtensionName(mysubfile) = "csv" Then
            
            With adoSt
            .Charset = "UTF-8"
            .Open
            .LoadFromFile (mysubfile)
                        
            str = .ReadText         
            .Close
            End With

            MsgBox str
        End If
    Next
    
    Set fs = Nothing

End Sub

事例7｜フォルダ内のテキストファイルを全て読み込む

'事例7｜フォルダ内のテキストファイルを全て読み込む
Sub ReadTxtFiles()
    
    Dim path As String
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
    Dim txt As TextStream
    Dim str As String
    Dim adoSt As Object
    Set adoSt = CreateObject("ADODB.Stream")
    
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
   
    For Each mysubfile In mysubfiles
             
        If fs.GetExtensionName(mysubfile) = "txt" Then
            
            With adoSt
            .Charset = "UTF-8"
            .Open
            .LoadFromFile (mysubfile)
            str = .ReadText            
            .Close
            
            End With
            
            MsgBox str
        End If
    
    Next
    
    Set fs = Nothing

End Sub

フォルダ内の複数ファイルを他のフォルダへコピーする

事例8｜フォルダ内の全てのファイルを新しいフォルダに移動する
事例9｜フォルダ内の全てのファイルを既存のフォルダにコピーする
事例10｜フォルダ内のファイルの内、特定の名前を含むファイルのみを移動する

以下でプログラムの解説をします。

事例8｜フォルダ内の全てのファイルを新しいフォルダに移動する

Option Explicit
'事例8｜フォルダ内の全てのファイルを新規のフォルダにコピーする
Sub MoveToNewFolder()
        
    'ステップ1｜変数定義
    Dim path As String
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
    Dim str As String
    Dim NewFolder As String
    
    'ステップ2｜FileSystemObjectの変数設定
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
   
    'ステップ3｜「NewFolder」という新しいフォルダを作成する
    NewFolder = ThisWorkbook.path & "\NewFolder"
    fs.CreateFolder NewFolder
   
    'ステップ4｜指定フォルダ内のファイルを繰り返しを読み込む
    For Each mysubfile In mysubfiles
        
        'ステップ5｜ファイルを「NewFolder」内に保管する
        str = NewFolder & "\" & fs.GetFileName(mysubfile)
        fs.MoveFile Source:=mysubfile, Destination:=str

    Next
End Sub

事例9｜フォルダ内の全てのファイルを既存のフォルダにコピーする

'事例9｜フォルダ内の全てのファイルを既存のフォルダにコピーする
Sub MoveToExistedFolder()
        
    'ステップ1｜変数定義
    Dim path As String
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
    Dim str As String, CopyFolder As String
    Dim copypath As String
    
    'ステップ2｜FileSystemObjectの変数設定
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
   
    'ステップ3｜移動先として既存フォルダを設定する
    CopyFolder = ThisWorkbook.path & "\1_移動先"
   
    'ステップ4｜指定フォルダ内のファイルを繰り返しを読み込む
    For Each mysubfile In mysubfiles
        copypath = CopyFolder & "\" & fs.GetFileName(mysubfile)

        'ステップ5｜ファイルを移動する
        fs.CopyFile Source:=mysubfile, Destination:=copypath, Overwritefiles:=True

    Next
End Sub

事例10｜フォルダ内のファイルの内、特定の名前を含むファイルのみを移動する

'事例10｜フォルダ内のファイルの内、特定の名前を含むファイルのみを移動する
Sub MoveToFolderSpecifieName()
        
    'ステップ1｜変数定義
    Dim path As String
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
    Dim str As String, CopyFolder As String
    Dim CopyPath As String
    
    'ステップ2｜FileSystemObjectの変数設定
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
   
    '作ったフォルダ"test"を移動します
    CopyFolder = ThisWorkbook.path & "\1_移動先"
   
    'ステップ4｜指定フォルダ内のファイルを繰り返しを読み込む
    For Each mysubfile In mysubfiles
        If InStr(fs.GetBaseName(mysubfile), "Excel") > 0 Then
            CopyPath = CopyFolder & "\" & fs.GetFileName(mysubfile)
            'ステップ5｜ファイルを移動する
            fs.CopyFile Source:=mysubfile, Destination:=CopyPath, Overwritefiles:=True
        
        End If
    Next
End Sub

フォルダ内の複数ファイルを印刷する

事例11｜フォルダ内のエクセルファイルを全て印刷する
事例12｜フォルダ内のエクセルファイルを全てPDFにする

以下でプログラムの解説をします。

事例11｜フォルダ内のエクセルファイルを全て印刷する

Option Explicit
'事例11｜フォルダ内のエクセルファイルを全て印刷する
Sub PrintAllExcelFiles()
        
    'ステップ1｜変数定義
    Dim path As String
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
    Dim str As String
    
    'ステップ2｜FileSystemObjectの変数設定
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
   
    'ステップ4｜指定フォルダ内のファイルを繰り返しを読み込む
    For Each mysubfile In mysubfiles
        
        'ステップ5｜ファイルを開く、閉じる
        
        If fs.GetExtensionName(mysubfile) Like ["xls*"] Then
        
            Workbooks.Open Filename:=mysubfile.path
            
            'シートを全て印刷する（印刷プレビュー）
            ActiveWorkbook.Sheets.PrintPreview
            
            'シートを全て印刷する（実際に印刷する）
            ActiveWorkbook.Sheets.PrintOut
            
            'ステップ6｜ファイルを閉じる
            ActiveWorkbook.Close
        End If

    Next
End Sub

事例12｜フォルダ内のエクセルファイルを全てPDFにする

'事例12｜フォルダ内のエクセルファイルを全てPDFにする</h3>
Sub PrintAllExcelFilesAsPFD()
    
    'ステップ1｜変数定義
    Dim path As String
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
    Dim ws As Worksheet
    Dim savename As String
    
    'ステップ2｜FileSystemObjectの変数設定
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
   
    'ステップ4｜指定フォルダ内のファイルを繰り返しを読み込む
    For Each mysubfile In mysubfiles
        
        'ステップ5｜ファイルを開く、閉じる
        '"xls"→　"xlsx"、"xlsm"に変更しても問題ない
        If fs.GetExtensionName(mysubfile) Like ["xls*"] Then
        
            Workbooks.Open Filename:=mysubfile.path
            
            For Each ws In ActiveWorkbook.Sheets
                savename = ThisWorkbook.path & "\" & fs.GetBaseName(mysubfile.Name)
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=savename
                'シートを全て印刷する
            Next
            'ステップ6｜ファイルを閉じる
            ActiveWorkbook.Close
        End If
    Next
    
End Sub

フォルダ内の複数ファイルのデータを一つにまとめる(集約する)

事例13｜フォルダ内のエクセルファイルを全て一つのエクセルにまとめる

以下でプログラムの解説をします。

事例13｜フォルダ内のエクセルファイルを全て一つのエクセルにまとめる

'事例13｜フォルダ内のエクセルファイルを全て一つのエクセルにまとめる
Sub GetDataFromExcels()
        
    'ステップ1｜変数定義
    Dim path As String
    Dim cmax1 As Long, cmax2 As Long
    Dim i As Long, j As Long, n As Long
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    
    Dim fs As Scripting.FileSystemObject
    Dim basefolder As Scripting.Folder
    Dim mysubfiles As Scripting.Files
    Dim mysubfile As Scripting.File
    
    'ステップ2｜集約用エクセルの変数設定
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Worksheets("集約用シート")
    n = 0
    
    'ステップ3｜FileSystemObjectの変数設定
    path = ThisWorkbook.path & "\0_子ファイル"
    Set fs = New Scripting.FileSystemObject
    Set basefolder = fs.GetFolder(path)
    Set mysubfiles = basefolder.Files
   
    'ステップ4｜指定フォルダ内のファイルを繰り返しを読み込む
    For Each mysubfile In mysubfiles
        
        'ステップ5｜ファイル拡張子を取得し
        'エクセル(xls, xlsx, xlsm)のみ選択する
        If fs.GetExtensionName(mysubfile) Like "[xls]*" Then
        
            'ステップ6｜エクセルファイルを開く
            Application.DisplayAlerts = False
            Workbooks.Open Filename:=mysubfile.path
            Application.DisplayAlerts = True
        
            'ステップ7｜開いたエクセルファイル(子エクセル)の変数設定
            Set wb2 = ActiveWorkbook
            Set ws2 = wb2.Worksheets(0)
            
            'ステップ8｜子エクセルの最終行の値を取得
            cmax2 = ws2.Range("A1048576").End(xlUp).Row
            
            'ステップ9｜子エクセルのデータを集約用エクセルに書き込む
            For j = 2 To cmax2
                cmax1 = ws1.Range("A1048576").End(xlUp).Row + 1
                ws1.Range("A" & cmax1 & ":E" & cmax1).Value = ws2.Range("A" & i & ":E" & i).Value
            Next
                        
            'ステップ10｜子エクセルを閉じる
            Application.DisplayAlerts = False
            wb2.Close
            Application.DisplayAlerts = True
            Set wb2 = Nothing
            
        End If
    
    Next

    'ステップ11｜集約用エクセルを上書き保存する
    Application.DisplayAlerts = False
    wb1.Save
    Application.DisplayAlerts = True
    Set wb1 = Nothing
    
End Sub

まとめたエクセルデータを集計する

事例13でまとめたデータを集計分析したい場合は、以下の記事が良い参考になるはずです。

www.fastclassinfo.com

ぜひ合わせて読んでみてください。

マクロをさらに使いこなすためには

この記事では、複数ファイルを処理するマクロについて紹介しました。ここで紹介したマクロを利用すれば、作業の自動化が可能になります。

しかしデメリットもあります。それはカスタムできないことです。

なぜなら、色々な要望が増えるからです。

この動画を見たとき、「もっと○○ができるのでは？」や「ここはなんとかならないのか」と感じる人は少なくないはずです。

例えば、「他の条件を付け加えたい」や「日付毎に条件を変えたい」といった要望が出るかもしれません。

このような要望を満たすには、マクロを勉強して自力でマクロを編集できるようになる必要があります。

もし、自力でマクロを編集できるようになれば、今より仕事の効率はグッと上がります。

実際、私も自力でマクロを書けるようになってからは、仕事の生産性が一気に上がりました。

他の人が30分～1時間かけて行う仕事が、ボタン一つで終わらせることができるようになったのです。その結果、周囲からの信頼も増し、仕事で高い評価を得られるようになりました。

ただ、要望に応えるようになるためには、マクロを学ぶ必要があります。

まずは無料でマクロを勉強してみる

ウェブや書籍で勉強すれば、マクロを習得できると考えている人は少なくありません。

しかし、仕事で使えるマクロを習得したいなら、仕事で使える部分に特化した教材で学ぶことをお勧めします。

なぜなら、ウェブや書籍には仕事に関係しない部分まで提供していることが多いからです。

例えば、マクロ初心者なのに配列を学ぼうとする人がいます。実は配列なしでも仕事で使えるマクロを書くことは可能です。

しかし、マクロ初心者ほど「全ての知識が必要だ」と考えて、無駄な学習に時間を使ってしまうのです。詳しくは、こちらの記事で紹介しています。

www.fastclassinfo.com

そこで、私がお勧めするのは仕事に直結するマクロ教材です。とくにお勧めするのは、こちらの無料オンライン動画です。

なぜなら、仕事に直結する部分に絞って、エクセルマクロを学ぶことができるからです。

マクロの作り方・考え方から解説しているので、教材をしっかり学べばここで紹介したマクロをゼロから書けるようになります。

マクロ初心者が、仕事に直結したいマクロを学ぶなら、まずはこちらの無料オンライン動画を試すのがいいです。

興味がある人は、まずは無料でエクセルマクロの勉強を始めてみてください。

もっと学びたいと感じたら、さらに深く勉強をしてみることをお勧めします。

エクセルマクロ関連のお勧め記事

エクセルマクロVBAに関連する情報は、こちらの記事で解説しています。ぜひ合わせて読んでみてください。

●エクセルで仕事の流れを改善した事例
 ●エクセルマクロVBAを習得した人の体験談
 ●エクセルマクロVBAで在庫管理する方法
 ●エクセルマクロVBAとは何か？　メリットや意味
 ●エクセルマクロVBAで出来ること
 ●エクセル関数よりエクセルマクロVBAを習得した方がいい理由
 ●今すぐ使えるマクロVBA入りのエクセルをダウンロード