VBA

【VBA実践編1-5】複数のファイルを連続で編集して保存する

実践編1-4では、ファイルダイアログを使ってフォルダを選択できるようになりました。

ここで、これまでの処理を振り返ってみます。

これまでの処理
  • 別ファイルを編集して保存する
  • 指定したフォルダからファイル名を取得する
  • 取得したファイル名をシートに入力する

これらの処理を使って、ファイルを連続で編集するのが、1-5の処理になります。

さらに連続で編集するだけではなく、ファイルごとに編集する内容を変えていきます。

編集したい内容はシートに入力しておきます。

具体的な処理の流れはこちら。

今回の処理
  • 編集したいファイルがあるフォルダを選択
  • ファイル名をシートに入力
  • シートに編集したい内容を入力
  • シートに入力されたファイルをすべて編集して保存する

目次

複数のファイルを連続で編集して保存をするVBAコード

フォルダ構成

movie_retal

├ sample.xlsm

├ incomplete(dir)

│    ├ 処理するファイル

├ complete(dir)

│    ├ 保存したファイル

処理するファイルを「incomplete」に入れています。

実践編1-4でフォルダを選択できるようになったので、ここはお好みで大丈夫です。

最終的に編集して保存したファイルは「complete」フォルダに入ります。

 

下記が今回のコードになります。

Sub ModifyFile()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    '編集するファイルのパスを取得する
    Dim i As Long
    i = 8 'ファイル名が入力されている最初の行
    
    Dim lRow As Long
    lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim filePath As String
    Dim content As Long
    Dim memo As String
    'ファイル名、内容、メモを取得し、Rentalプロシージャにわたす
    For i = 8 To lRow
        With ws
            filePath = .Cells(i, 1).Value
            content = .Cells(i, 2).Value
            memo = .Cells(i, 3).Value
        End With
        Call Rental(filePath, content, memo)
    Next

End Sub

Sub Rental(ByVal filePath As String, ByVal content As Long, ByVal memo As String)
    'ファイルを開く
    Dim wb As Workbook
    Set wb = Workbooks.Open(fileName:=filePath)
    
    Dim ws As Worksheet
    Set ws = wb.ActiveSheet
    
    '開いたファイルの最終行を取得する
    Dim lRow As Long
    lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
    '2列目と3列目の1行目から最終行まで同じ内容を入力する
    ws.Cells(2, 2).Resize(lRow - 1, 1).Value = content
    ws.Cells(2, 3).Resize(lRow - 1, 1).Value = Date
    
    '4列目にメモを入力する(行ごとに処理を分ける)
    Dim i As Long
    For i = 2 To lRow
        If ws.Cells(i, 4).Value = "" Then
            ws.Cells(i, 4).Value = memo
        Else
            ws.Cells(i, 4).Value = ws.Cells(i, 4).Value & vbCrLf & memo
        End If
    Next i
    
    '日付の書式を変更する 例)2020/03/05 00:00
    ws.Cells(2, 3).Resize(lRow - 1, 1).NumberFormatLocal = "yyyy/mm/dd hh:mm"
    
    '保存するパスを指定する
    Dim savePath As String
    savePath = ThisWorkbook.Path & "\complete\" & Format(Now, "yyyymmddhhmmss") & wb.Name
    
    'ファイルを別名保存して閉じる
    wb.SaveAs fileName:=savePath, FileFormat:=xlCSV, local:=True
    wb.Close savechanges:=False
    
End Sub

 

今回は2つのプロシージャを使用します。

1つは実践1-1で使用した「Rental」プロシージャに少し修正を加えています。

このプロシージャは、ファイルを開いて編集して保存するという処理です。

もう1つのプロシージャ「ModifyFile」は、シートにあるファイル名や編集したい内容を取得し「Rental」プロシージャに渡す役割です。

 

これに合わせて、シートを以下のように変更しています。

 

ファイルごとに内容とメモを変えたいので、表形式にしました。

「処理開始」ボタンを押すと、8行目の1列目の処理するファイル名から、すべてのファイルに対して処理を行っていきます。

「処理開始」ボタンには「ModifyFile」プロシージャを登録しています。

VBAコードの解説

今回の処理のポイントは、プロシージャからプロシージャを呼び出す部分です。

Subプロシージャを別のプロシージャから呼び出すときは「Call」を使用します。

さらにプロシージャには引数を渡して実行します。

こうすることで、1つのプロシージャで違った値の処理を行うことができるようになります。

シート操作の準備

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
    
'編集するファイルのパスを取得する
Dim i As Long
i = 8 'ファイル名が入力されている最初の行
    
Dim lRow As Long
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

 

シートを操作するための準備を行います。

ファイル名が入力される最初の行を変数に入れ、最終行を取得します。

最終行になるまで繰り返し処理を行う

Dim filePath As String
Dim content As Long
Dim memo As String
'ファイル名、内容、メモを取得し、Rentalプロシージャにわたす
For i = 8 To lRow
    With ws
        filePath = .Cells(i, 1).Value
        content = .Cells(i, 2).Value
        memo = .Cells(i, 3).Value
    End With
    Call Rental(filePath, content, memo)
Next

 

for文を使い、ファイル名が入力されている最終行まで、繰り返し処理を行います。

シートから、Rentalプロシージャに渡す引数を変数に代入します。

今回は、filePath、content、memoの3つの変数を引数として、Rentalプロシージャにわたします。

Rentalプロシージャを実行する

Sub Rental(ByVal filePath As String, ByVal content As Long, ByVal memo As String)
    'ファイルを開く
    Dim wb As Workbook
    Set wb = Workbooks.Open(fileName:=filePath)
    
    Dim ws As Worksheet
    Set ws = wb.ActiveSheet
    
    '開いたファイルの最終行を取得する
    Dim lRow As Long
    lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
    '2列目と3列目の1行目から最終行まで同じ内容を入力する
    ws.Cells(2, 2).Resize(lRow - 1, 1).Value = content
    ws.Cells(2, 3).Resize(lRow - 1, 1).Value = Date
    
    '4列目にメモを入力する(行ごとに処理を分ける)
    Dim i As Long
    For i = 2 To lRow
        If ws.Cells(i, 4).Value = "" Then
            ws.Cells(i, 4).Value = memo
        Else
            ws.Cells(i, 4).Value = ws.Cells(i, 4).Value & vbCrLf & memo
        End If
    Next i
    
    '日付の書式を変更する 例)2020/03/05 00:00
    ws.Cells(2, 3).Resize(lRow - 1, 1).NumberFormatLocal = "yyyy/mm/dd hh:mm"
    
    '保存するパスを指定する
    Dim savePath As String
    savePath = ThisWorkbook.Path & "\complete\" & Format(Now, "yyyymmddhhmmss") & wb.Name
    
    'ファイルを別名保存して閉じる
    wb.SaveAs fileName:=savePath, FileFormat:=xlCSV, local:=True
    wb.Close savechanges:=False
    
End Sub

 

ModifyFileプロシージャから受け取った引数を使い、処理を行います。

引数にはデータ型と参照渡し・値渡しを指定しています。

引数は、引数名をそのまま処理の中で使用できます。

4行目にファイルパスの入った引数「filePath」を、14行目に内容の入った引数「content」、21行目・23行目にメモが入った引数「memo」を使っています。

こうやって引数として渡すことで、違う値を使って処理を行うことができるようになります。

詳しい処理の内容は実践編1-1を参照してください。

まとめ

今回は、実践編1-1で行ったファイルへの処理を連続で行うように変更しました。

これで一連の処理がすべて自動化できたことになります。

ファイル数が増えれば増えるほど、この処理の効果が発揮できます。

今回の処理は一例ですので、自分自身が実務で行っている内容に置き換えながらコードを変更してみてください。

また、今回のコードにはエラー対策などはほとんどしていません。

ファイル名が並んでいる行に途中に空白が入ってしまった場合や、内容・メモのデータ型が違っているといった予期しない事が起きるとエラーが発生してしまいます。

実務でより確実に使えるようにするには、こうしたエラー処理も追加していったほうが使いやすくなりますので、是非試してみてください。