ExcelVBA⑦（excelファイルをコピーする） - 情報と工夫で何とかやってみる（妥協点を見出す）ブログ

ExcelVBAシリーズ最後になります。
これまでに、このシリーズで「異なるファイルを添付して、異なる人にメールすること」、「ファイル名を一度に変更すること」を紹介させていただきました。
となると、「100人にExcelで作った申請書をメールして、それを返送してもらって、いちいちファイル名を変更して保存するのは面倒」と思うようになります、「最初からファイル名をつけておけばいいではないか（例えば人の名前）」と。ということで、Excelファイルを複数回コピーするコードが以下。専用のフォルダを用意しておいて、そこに保存すると、番号のついたファイルがコピーされます。それを、「ファイル名変更」で一気に人の名前のファイルに変更し、それをそれぞれメールすれば、申請者がファイル名を変更しない限りは、保存が楽になります。

Sub ファイルをコピーする()
Dim num As Variant, ans As Integer, i As Integer
Dim fold_dlg As FileDialog, file_dlg As FileDialog 'フォルダやファイルを参照するにはAs FileDialogを使う
Dim fold_path As String, file_path As String

num = Application.InputBox( _
Prompt:="コピーする回数を入力してください", _
Title:="ファイルをコピー", _
Type:=1)
If TypeName(num) <> "Boolean" Then
ans = MsgBox(num & "回コピーします", vbYesNo)
End If

If ans = 7 Then 'MsgboxでYesNOが表示される場合、Noは「7」が入る。なので7の時はSubプロシージャから抜ける
Exit Sub
End If

MsgBox "コピーするExcelファイルを選択してください"
Set file_dlg = Application.FileDialog(msoFileDialogFilePicker) 'file_dlgはオブジェクト関数なのでSetする
If file_dlg.Show = 0 Then 'キャンセルされた場合は0もしくはFalseが入るので、それが入ったらSubプロシージャから抜ける
Exit Sub
End If
file_path = file_dlg.SelectedItems(1) '1つしか選択できないが、selectedItemオブジェクトとして返されるので1つ目を取得する
MsgBox "コピーするファイルは" & file_path & "です"
Set file_dlg = Nothing 'setを開放する

MsgBox "ファイルの保存先を選択してください"
Set fold_dlg = Application.FileDialog(msoFileDialogFolderPicker) 'file_dlgはオブジェクト関数なのでSetする
If fold_dlg.Show = False Then 'キャンセルされた場合は0もしくはFalseが入るので、それが入ったらSubプロシージャから抜ける
Exit Sub
End If
fold_path = fold_dlg.SelectedItems(1) '1つしか選択できないが、selectedItemオブジェクトとして返されるので1つ目を取得する
MsgBox "コピーするファイルの保存先は" & fold_path & "です"
Set fold_dlg = Nothing 'setを開放する

If ans = 6 Then 'MsgboxでYesNOが表示される場合、Yesは「6」が入る。
For i = 1 To num
FileCopy file_path, fold_path & "\" & i & ".xlsx"
Next i
End If

MsgBox (num & "回コピーしました")