PR

【ExcelVBA】フォルダ内のファイルへ順番に書き込み処理をする方法

フォルダの操作

この記事ではフォルダ内にあるファイルをループ処理で調べて、順次対象のファイルに書き込んでいく処理を行うマクロについて説明しています。

すぐにコードが見たい方は見出しの「2.VBAコードの書き方」をクリックしてジャンプしてご覧ください。

スポンサーリンク

マクロで実行する内容

以下の動作を行うマクロを作成していきます。
下の枠内(②~⑤)はフォルダ内のファイルの数分繰り返し処理を行います。

① 対象のフォルダPATHを変数に格納する

② フォルダ内のファイル名を調べて、対象のファイル名の場合はファイルを開く
③ 開いたファイルが書き込めない場合
 ・ファイルを閉じる
 ・アラート用変数にファイル名をセット
④ 書き込める場合はA1セルに現在時刻を書き出す
⑤ 開いたファイルを保存して閉じる

⑥ 完了メッセージを出力
  書き込めないファイルがあった場合はメッセージに出力する

◆フォルダの状態

今回は実行するマクロのブックと書き込みたいファイルを同じフォルダに置いています。

・sample.xlsm  …実行するマクロのブック
・ファイルA.xlsx …書き込みたいブック
・ファイルB.xlsx …書き込みたいブック
・ファイルC.xlsx …書き込みたいブック

エクセルVBA-フォルダ内のファイルをループするマクロ-フォルダの状態

◆自ブックの実行前の状態

実行するマクロのブックには対象のフォルダパスを書いています。
フォルダパスは最後に「\」を付けて終わってください。

※対象のフォルダパスはコードに直接書くこともできますが、シートなどに書いておく方がメンテナンス性は良いです。(マクロを書けない人でも変更できて◎)

エクセルVBA-フォルダ内のファイルをループするマクロ-実行するマクロファイルの状態

◆データを書き込むファイルの実行前の状態

書き込む対象のファイルA~CのSheet1は空でなにもない状態にしてあります。
それぞれのファイルのシート1のA1セルに現在時刻を書き込んでいきます。

エクセルVBA-フォルダ内のファイルをループするマクロ-フォルダの状態

◆マクロ実行後の状態

マクロ実行後にそれぞれのファイルを開くと、書き込まれた時間が反映していることが分かります。
秒の部分が微妙に変化しています。

エクセルVBA-フォルダ内のファイルをループするマクロ-マクロ実行後の書き込まれたファイルの確認
スポンサーリンク

VBAコードの書き方

VBAコードは下のように書きます。コメント部分で各コードの説明を入れています。

Sub Sample()

Dim ForlderPath As String
Dim TargetBook As Workbook
Dim TargetFile As Object
Dim fso As Object
Dim MsgStr As String

    'アラートを表示しない
    Application.DisplayAlerts = False

    'シートに書いてあるフォルダパスを変数に設定
    ForlderPath = ActiveSheet.Range("B2")
  
    'フォルダが存在しない場合は終了する
    If Dir(ForlderPath) = "" Then
    
        'アラートメッセージを表示する
        MsgBox "フォルダが存在しません。処理を中止します。"
        
        '処理を抜ける
        Exit Sub
    End If
    
    'FileSystemObjectのインスタンスを作成
    Set fso = CreateObject("Scripting.FileSystemObject")
        
    'フォルダ内のファイルをループ
    For Each TargetFile In fso.GetFolder(ForlderPath).Files
    
        'ファイルの拡張子が「.xlsx」の場合
        If InStr(TargetFile.Name, ".xlsx") > 0 Then
        
            'ブックを開く
            Workbooks.Open Filename:=TargetFile.Path
            
            '開いたブックを変数にセットする
            Set TargetBook = ActiveWorkbook
        
            '読み取り専用の場合は終了する
            If TargetBook.ReadOnly = True Then
            
                '開いたファイルを閉じる
                TargetBook.Close
                
                'アラート用の変数にファイル名を格納する
                MsgStr = MsgStr & TargetFile.Name & vbLf
             
            Else

                '開いたブックへ現在時刻を書き出す
                TargetBook.Worksheets("Sheet1").Range("A1") = Now()

                '開いたファイルを閉じる(保存する)
                TargetBook.Close SaveChanges:=True

            End If
        
        End If
        
    Next TargetFile
    
    '書き込みできなかったファイルがある場合はメッセージを表示
    If MsgStr <> "" Then
        MsgBox "下記のファイルには書き込みできませんでした。" & vbLf & MsgStr
      Else
        MsgBox "正常完了しました。"
    End If
        
    '変数の初期化・解放
    Set fso = Nothing
    Set TargetFile = Nothing
    Set TargetBook = Nothing
    
    'アラートの表示設定を戻す
    Application.DisplayAlerts = True
    
End Sub
スポンサーリンク

解説:フォルダ内のファイルをループ

対象のフォルダ内のファイルをループする処理はFileSystemObjectを使用しています。
フォルダ内にあるファイルをすべてチェックし、今回はファイルの拡張子が「.xlsx」の場合だけファイルを開くように指定しています。

Instr関数でファイル名に「.xlsx」の文字が含まれるかを数えて、0より大きい場合、処理をするようになっています。

If InStr(TargetFile.Name, “.xlsx”) > 0 Then

マクロを実行しているブックも同じフォルダにありますが、拡張子が「.xlsm」のためスキップされています。

特定のファイル名のもののみ処理したい場合もここで指定することが可能です。

    'FileSystemObjectのインスタンスを作成
    Set fso = CreateObject("Scripting.FileSystemObject")

    'フォルダ内のファイルをループ
    For Each TargetFile In fso.GetFolder(ForlderPath).Files
    
        'ファイルの拡張子が「.xlsx」の場合
        If InStr(TargetFile.Name, ".xlsx") > 0 Then
      '(実行したい処理)
        End If
        
    Next TargetFile
スポンサーリンク

解説:開いたファイルが書き込める状態かチェック

ファイルを開いたあとは、ファイルが書き込み可能かを確認しています。
開いたファイルへ書き込まない処理の場合はここは不要になります。

今回は書き込みを行いたいので、開いたブックが「ReadOnly = True 」、読み取り専用の場合はすぐにファイルを閉じて、後で分かるように書き込めなかったファイル名を一旦変数に格納しています。

‘ファイルが読み取り専用の場合
If TargetBook.ReadOnly = True Then

‘アラート用の変数にファイル名を格納する
MsgStr = MsgStr & TargetFile.Name & vbLf

            '読み取り専用の場合は終了する
            If TargetBook.ReadOnly = True Then
            
                '開いたファイルを閉じる
                TargetBook.Close
                
                'アラート用の変数にファイル名を格納する
                MsgStr = MsgStr & TargetFile.Name & vbLf
             
            Else

                '開いたブックへ現在時刻を書き出す
                TargetBook.Worksheets("Sheet1").Range("A1") = Now()

                '開いたファイルを閉じる(保存する)
                TargetBook.Close SaveChanges:=True

            End If

すべてのファイルの処理が終わってから、変数「MsgStr」の値が空かどうかを調べます。
空ではない場合は、書き込めなかったファイルがあるということなので、メッセージに書き込めなかったファイル名を表示してお知らせしています。

    '書き込みできなかったファイルがある場合はメッセージを表示
    If MsgStr <> "" Then
        MsgBox "下記のファイルには書き込みできませんでした。" & vbLf & MsgStr
      Else
        MsgBox "正常完了しました。"
    End If

ファイルBとCだけ読み取り専用にしておいてから実行してみると以下のメッセージが表示されました。

下記のファイルには書き込みできませんでした。
ファイルB.xlsx
ファイルC.xlsx

エクセルVBA-フォルダ内のファイルをループするマクロ-書き込めないファイルがあった場合のメッセージ
スポンサーリンク

関連記事(他のブックの操作)

下の記事では特定のファイル1つに対して処理を行うマクロについて説明しています。

スポンサーリンク

※コードのコピー利用について

・コードのコピーは自由におこなっていただけます。
・気を付けて作成はしていますがコードには誤りがある可能性があります。
・自身の環境で動作確認をしていますが、すべての方の環境で同様に動くことは保証できません。
・データの破損等の責任は負いかねますのでご自身の責任のもとお使いください。

タイトルとURLをコピーしました