2020/01/03

ブックを開いた時に自動的にバックアップを取る




Excelを使って、毎日のようにデータを追加・修正・削除するような場面は多いと思います。ところが、ファイルは壊れたり、または故意的に壊されたりすることがありますので、データのバックアップというのは大切になります。

ここで質問ですが、あなたは自分のパソコン上に作業ファイルを置いていませんか？　あなたのＰＣ上のファイルは定期的にバックアップを取っていますか？　また、ファイルは共有のファイルサーバに置いてあるとして、サーバはどのくらいの頻度でバックアップを取っているか知っていますか？
「それはサーバ管理者の仕事だ」と言わないで下さい。失って泣くのはあなたなのですから。

という事で、自分にとって、また皆にとって大切なファイルは自分でバックアップしよう、と思われた方へ自動バックアップをするマクロを説明します。

１．バックアップマクロの概要

ＰＣ上でもファイルサーバ上でも良いのですが、使っているExcelファイルにバックアップ機能のマクロを載せます。作業でExcelファイルを開くたびに「バックアップをして下さい」などダイアログが出てもウルさいだけですので、勝手にバックアップをします。バックアップファイルには、バックアップした日付をファイル名に付けます。
バックアップは、あらかじめ決められたフォルダーに定期的に行います。どのくらい定期的にするかは、そのファイルの重要度から決めて下さい。こまめにやればやるほど良いのは分かりますが、ファイルにも容量というものがあるので、その辺も考慮して決めて下さい。
また、壊れるとすればＰＣ・サーバ・ＨＤまるごとです。せっかくバックアップするのであれば別の媒体（本体ファイルの置いてある場所とは異なるＨＤやサーバ、メモリーなど）に行うのが基本と思います。

プログラムの大雑把な流れは図１－１の様に考えました。（ど素人のフローチャートでお恥ずかしい限りです）

図１－１

２．イベントを使ってファイルを作る

「ファイル（ブック）を開く」という動作と同時にマクロが動かなければいけないので「Workbook_Open」イベントを使います。図２－１の通り「ThisWorkbook」の中にマクロを記載していきます。

図２－１

まず記載するプロシージャは、図２－２の「Private Sub Workbook_Open()」です。これはコードウィンドウの上のリストから左からは「Workbook」を、右からは「Open」を選ぶと自動的に生成されます。
その「Private Sub Workbook_Open()」のプロシージャの中にズラズラとコードを書いても良いのですが、「Workbook_Open」イベントで実施しなければいけない事（ファイルが開かれて、ユーザーが作業する前までにExcelがやっておく事）は多くのことがあるはずです。今時点では「自動バックアップ」だけかもしれませんが、のちに色々追加されるかもしれません。
基本的にプロシージャは「単機能」にすべきでありますし、拡張性を考え・不要になったら外す　ことを考え、「Workbook_Open」から機能を呼び出す、という方法が良いと思います。
  1. Private Sub Workbook_Open()
  2. 　Call Back_Up
  3. End Sub
図２－２

また、作業が終わってブックを閉じるタイミングでバックアップを取る、という方法も考えられます（図２－３）。その際には「Workbook_BeforeClose」イベントプロシージャの中に、Workbook_Openと同様「Call Back_Up」と機能を呼び出すコードを書けば良いことになります。
この「ブックを閉じる」時にバックアップをする方法では最後に作業した人が分かっているわけですから、ファイル名に作業者名を加える等の工夫をすれば、責任追跡性や否認防止の効果が多少得られるかもしれません。
  1. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  2. 　Call Back_Up
  3. End Sub
図２－３

３．バックアップ本体プロシージャ

では本体のプロシージャです。
２～１１行目は、内部で使用している変数の宣言です。この内　５・６・８行目はVariant型ですが、自作関数であるFunctionプロシージャから配列として返ってきた返り値を入れる入れ物ですので、最終的には配列の型（等）になります。どの大きさの配列が返ってくるか現時点では分からないので、例えば５行目を「Dim FL(5) As String」などとは言い切れませんし、「As String」と型指定をしてしまうと配列には変化できません。ですので「何のデータ型でも格納できるVariant型」で宣言しています。
また、１３行目を「Set FSO =・・・」は７行目の「Dim FSO As Object」に対応したもので、４４行目でファイルをコピーするCopyFileメソッドに必要なため、宣言部で宣言させています。
  1. Sub Back_Up()
  2. 　Dim Backup_Folder As String　　　　 '←バックアップファイルを入れるフォルダー
  3. 　Dim Backup_File_Name As String　　　 '←日付をつけたバックアップファイル名（フルパス）
  4. 　Dim Interval As Long　　　　　　 '←バックアップをする周期（日数）
  5. 　Dim FL As Variant　　　　　 '←バックアップフォルダのファイルリストの配列
  6. 　Dim FN As Variant　　　　　 '←バックアップフォルダのファイル名＋拡張子の配列
  7. 　Dim FSO As Object　　　　 '←ファイルコピーのオブジェクト
  8. 　Dim ThisFile As Variant　　　 '←コピー元ファイル（本ブック）のファイル名＋拡張子の配列
  9. 　Dim Hizuke As String　　　　 '←既存ファイルのファイル名についている日付部分
  10. 　Dim File_Date As Date　　　 '←ファイル名についている日付
  11. 　Dim cnt As Long　　　　　 '←カウンター
  13. 　Set FSO = CreateObject("Scripting.FileSystemObject")　　　' ←ﾌｧｲﾙｺﾋﾟｰのｵﾌﾞｼﾞｪｸﾄのｲﾝｽﾀﾝｽ化
  15. 　Interval = 2　　　　　 '←バックアップをする周期（日数）
  16. 　Backup_Folder = ThisWorkbook.Path & "¥bak"　　　　 '←ﾊﾞｯｸｱｯﾌﾟﾌｫﾙﾀﾞｰ(フルパスで指定して下さい)
  17. 　ThisFile = File_Name_Split(ThisWorkbook.Name)　　 '←ｺﾋﾟｰ元ﾌｧｲﾙ(本ﾌﾞｯｸ)をﾌｧｲﾙ名本体+拡張子の配列にする
  19. 　If Dir(Backup_Folder, vbDirectory) = "" Then　　　　 '←バックアップのフォルダの有無を確認
  20. 　　MkDir Backup_Folder　　　　 '←フォルダが無かったら作る
  21. 　End If
  23. 　FL = File_List(Backup_Folder)　　　　 '←ﾊﾞｯｸｱｯﾌﾟﾌｫﾙﾀﾞ内のﾌｧｲﾙ名一覧を配列に。無かったらEmpty
  25. 　File_Date = 0　　　　 '←ﾌｧｲﾙ名の中の日付の初期値設定(0＝1900/1/1の前日相当)
  26. 　If IsEmpty(FL) = False Then　　　 '←ﾊﾞｯｸｱｯﾌﾟﾌｫﾙﾀﾞ内がカラだったらﾊﾞｯｸｱｯﾌﾟﾌｧｲﾙ作成へ飛ぶ
  27. 　　For cnt = 1 To UBound(FL, 1)　　　 '←存在するﾌｧｲﾙ数分だけForを回す
  28. 　　　FN = File_Name_Split(FL(cnt))　　　 '←ﾌｧｲﾙ名本体＋拡張子に分ける
  29. 　　　If (ThisFile(1) = Left(FN(1), Len(ThisFile(1)))) And (ThisFile(2) = FN(2)) Then　　　 '←ﾌｧｲﾙ名(前半)と拡張子を比較
  30. 　　　　Hizuke = Mid(FN(1), Len(ThisFile(1)) + 2, 10)　　 '←ﾌｧｲﾙ名から日付部分を取り出す
  31. 　　　　If IsDate(Hizuke) Then　　　　 '←日付部分が本当に日付型か確認
  32. 　　　　　If DateValue(Hizuke) > File_Date Then　　　 '←より大きな(新しい)日付かを確認
  33. 　　　　　　File_Date = DateValue(Hizuke)　　　　 '←変数により大きな(新しい)日付を代入
  34. 　　　　　End If
  35. 　　　　End If
  36. 　　　End If
  37. 　　Next cnt
  38. 　End If
  40. 　If DateDiff("d", File_Date, Date) >= Interval Then　　　 '←今日の日付と比べてｲﾝﾀｰﾊﾞﾙ日数分より多いか確認
  41. 　　Backup_File_Name = Backup_Folder & "\" & ThisFile(1) & Format(Date, "(yyyy-mm-dd)") & ThisFile(2)
  42. 　　　　　　　'↑ 今日の日付を足した新ﾌｧｲﾙ名を設定
  43. 　　On Error Resume Next　　　　　　 '←ｺﾋﾟｰでｴﾗｰが出ても進める
  44. 　　　FSO.CopyFile ThisWorkbook.FullName, Backup_File_Name, True　　　 '←ﾊﾞｯｸｱｯﾌﾟﾌｧｲﾙをｺﾋﾟｰ
  45. 　　　If Err.Number <> 0 Then MsgBox ("ファイルバックアップに失敗しました")　　 '←ｺﾋﾟｰでｴﾗｰが出たらｺﾒﾝﾄを出す
  46. 　　On Error GoTo 0
  47. 　End If
  48. 　Set FSO = Nothing
  49. End Sub
図３－１

では図３－１のコードを説明していきます。１５行目からです。
１５行目はバックアップする周期ですが、コード内で変更されるものでは無いのでConstantで固定する方が良いかもしれません。また、日にち単位ではなく時間単位でバックアップを取る必要がある場合は、時間・分 等をファイル名に盛り込んだものに改造する必要がありますし、Intervalも時間・分で設定する必要があります。

次の１６行目は、バックアップファイルを格納しておくフォルダーを指定します。１６行目の「ThisWorkbook.Path & "¥bak"」のように同じディスク内に置くことも出来ますが、先頭でも書きましたが別の媒体にバックアップを取るのが基本です。（今回はトライを簡単にできるように、このように記述しました。）

１７行目は、図５－１の自作関数「ファイル名をファイル名単体＋拡張子に分解する関数」を使用した、バックアップをするファイル本体のファイル名を分解しているものです。例えば「abcd.efgh.xlsm」がファイル名とすると、ThisFile配列の(1)に「abcd.efgh」、配列の(2)に「.xlsm」が入ります。最後のピリオドから後を拡張子とし、訳あって「ピリオド」を含めています。

abcd.efgh.xlsm
abcdefgt
　→　
　→　
　　1　　　　2　　
abcd.efgh.xlsm
abcdefgh(Empty)
　・・・ピリオドがあるファイル名の場合
　・・・ピリオドが無いファイル名の場合
図３－２

この自作関数の詳細については、図５－１の下側で説明します。

１９～２１行目は、Dir関数でバックアップフォルダ―の存在有無を確認し、もし無かった場合はMkDirでフォルダーを作成しています。尚、フォルダ―を作成できるか、またその中にバックアップファイルを作成できるか否かは書き込み権限が関係してきます。Ｏ／Ｓによって権限の扱い方は異なりますが、確実なのは事前にトライし実行時エラー「パス名が無効です」等が出ないでファイルが作成されるかを確認することです。少なくともフォルダーくらいは事前に作っておくのが良いと思います。

２３行目は、図４－１の自作関数「引数で与えたフォルダ内のファイルの一覧にする関数」を使用してバックアップフォルダ―の中に入っているファイルを配列として受け取っています。そのファイルのファイル名を調べることで、バックアップファイルを作成する必要があるかを判断しています。尚、フォルダー内にファイルが１つも無い場合には「Empty」が返ってきます。

その「バックアップファイルを作成するかの判断」部分ですが、有り得る条件としてはフォルダーが空だったことも含めて、様々考えなくてはいけません。
（本来なら「バックアップファイル以外はフォルダー内に無いはず」なので、「空か」「最も新しい日付ファイルは何か」だけを判断すれば良いはずなのですが、ユーザの誤操作なども考えて色々なファイルが混在している状況に対応させています）

まず、フォルダーが空だったら無条件にバックアップファイルを作る必要があります。図３－３は、様々なファイル名（フォルダーが空も含め）を順々にフルイに掛けて最終的に目的のものを得る、というイメージ図です。フォルダーが空の状態は図３－３の左端部分になります。


図３－３

次にファイルが存在する場合には、そのファイル名と自分のファイル名を比較していきます。
比較するに当たって、今回バックアップファイルのファイル名は、

　　元のファイル名本体　＋　（バックアップ日付）　＋　拡張子　　
図３－４

という「日付を元のファイル名本体と拡張子で挟む形」と設定したため、ファイル名を「頭から」と「お尻から」の２通りで比較する必要が出てしまいました。「日付をファイル名の先頭に」設定すれば、比較は「お尻から」の１種類に出来ると思いますが、「同じフォルダーに様々なファイルのバックアップファイルが格納される」ことを想定すると、フォルダー内で目的のファイルを人の目では探し辛くなってしまうデメリットも生じます。

ファイル名本体と拡張子に分解する（２８行目）のは、１７行目の処理と同じで図５－１の自作関数「File_Name_Split」を使用し、「ファイル名本体（前半）」の比較と「拡張子」の比較は、Andを使って同時に確認を行っています（２９行目）。
「ファイル名本体（前半）」は、調べるファイル名を元のファイル名の長さ分だけ抜き出すために「Left(FN(1), Len(ThisFile(1)))」という式を使っています。（FN(1)＝調べるファイル名、ThisFile(1)＝元のファイル名）

３０行目で日付部分を摘出していますが、日付部分は「ファイル名本体の後にカッコで囲まれている」＋「日付は yyyy-mm-dd という形式（全10文字）」という前提で取り出しています。
カッコ内の文字列が本当に日付か否かは３１行目のIsDate関数で調べています。もし調べるファイル名が元のファイル名と全く同じだった場合（元のファイルとバックアップファイルが同じフォルダーに入っている場合）には、日付部分は空の文字列（""）として取り出されますので日付型確認ではねられます。

最終的に日付は最も大きな（最新の）日付が必要となりますので、３２行目で大きさ比較をし大きかった（最新だった）日付を３３行目で残していきます。その初期値として最も小さな日付として２５行目でゼロを設定しています。日付は1900年1月1日を1として数えていきますのでゼロはその前日になり日付とは言えないですが、計算上は成立しています（VBAでは1899年12月30日をゼロ）。

尚、フォルダーにファイルが存在する場合には、２７行目のForで回して１つずつ調べていきますが「ファイル数＝ファイル名が格納されている配列FLのサイズ」ですので、配列の大きさ（要素数）を調べるUBound関数で求めます。尚ファイル名を入れた配列は１次元ですので２番目の引数は「１」となります。

Forを抜けた時（フォルダー内のファイル名を調べ終わった時）、またはフォルダーが空だった時は４０行目に進みます。４０行目では最新のファイル日付（フォルダーが空だった時は1900年1月0日）と今日の日付とを比べて、バックアップ間隔以上かを調べます。

バックアップ間隔以上の場合は、今日の日付を入れたファイル名を設定（４１行目）し、４４行目でファイルコピーを行います。

同じ内容のファイルを作る方法として、他には「FileCopyメソッド」や「SaveAsメソッド」がありますが、「FileCopyメソッド」を使い
  1. 　　FileCopy ThisWorkbook.FullName, backup_file_name
図３－５

とすると、ThisWorkbook（マクロが記録してあるファイル）を開いてしまっているためエラーが発生します。

また、「SaveAsメソッド」を使い
  1. 　　ThisWorkbook.SaveAs backup_file_name
図３－６

とすると、開けたファイルの名前が変わってしまうため「元のファイル名が変わってしまい」使えません。

尚、ファイルコピーが失敗した場合を考慮し、４３・４５行目でエラー処理をしています。
最後に、FSO変数からオブジェクトへの参照を解除します。

４．フォルダー内のファイル一覧取得

４－１．引数にフォルダーを指定する方法

本体プロシージャの中の２３行目で使用した自作関数 File_Listは「引数で与えたフォルダ内のファイル名を配列にして返す」という機能を持たせています。
  1. Function File_List(Backup_Folder) As Variant
  2. 　Dim Buf As String　　　　 '←ﾌｧｲﾙ名を一時入れておく変数
  3. 　Dim List_Array()　　　　 '←ﾌｧｲﾙ名を入れておく配列
  4. 　Dim cnt As Long　　　　 '←カウンター
  6. 　Buf = Dir(Backup_Folder & "¥*.*")　　　　 '←１つ目のﾌｧｲﾙ名を取得
  7. 　Do While Buf <> ""　　　　　　 '←フォルダー内の全てのﾌｧｲﾙ名を取得
  8. 　　cnt = cnt + 1
  9. 　　ReDim Preserve List_Array(1 To cnt)　　　　 '←配列をﾌｧｲﾙ数に合わせて大きくする
  10. 　　List_Array(cnt) = Buf　　　　　 '←配列にﾌｧｲﾙ名を代入
  11. 　　Buf = Dir()　　　　　 '←２つ目以降のﾌｧｲﾙ名を取得。無かったら空欄を返してくる
  12. 　Loop
  14. 　If cnt = 0 Then　　　　　　　　 '←ﾌｧｲﾙが一つも無かったら
  15. 　　File_List = Empty　　　　　　 '← File_ListにEmptyを入れておく
  16. 　Else
  17. 　　File_List = List_Array　　　　 '← ﾌｧｲﾙ名の入った配列をFunctionの変数にする
  18. 　End If
  19. End Function
図４－１

まず６行目で指定フォルダー内の１つ目のファイル名を取得します。今回はDir関数の引数として「Backup_Folder & "¥*.*"」を指定しましたが、これをファイル名まで指定する方法もありますが、それについては４－２項で説明します。

２つ目以降のファイル名は、７行目～１２行目のDo～Loop内で取り出します。もし１つ目のファイルが無い場合はDo～Loop内を飛ばして次に進んでいきます。
９行目でファイル名の入れ物であるList_Array配列の大きさを増やし１０行目で配列に代入しています。
そして２つ目以降のファイル名を１１行目で取り出します。尚、Dir関数で同じ引数を使用するときは「Dir()」と引数無しで使用しても「直前と同じ引数を使用している」と判断してくれます。

Do～Loopを抜けた（＝指定したファイルを全て取り出した）後、カウント変数 cntがゼロだった（＝６行目でファイル名を取得できなかった）時は、１５行目でFile_List（関数名＝返り値）にEmptyが代入されます。
それ以外（＝指定したファイルが存在する時）は１７行目でファイル名が代入された配列（List_Array配列）をFile_List（関数名＝返り値）に置き換えます。

よって、ファイルが存在する場合は「ファイル名の配列」を、ファイルが存在しない場合は「Empty」を返します。

４－２．引数にファイル名まで指定する方法

Dir関数でファイル名まで指定する方法は、「Backup_Folder & (元のファイル名本体) & "*." & (元のファイル名の拡張子)」のように最初からファイル名を絞り込んで検索するものです。そうすることで、図４－２の様にメインプロシージャでのその後の処理が楽になります。

図４－２

ファイル名まで指定する際には、まず自作関数 File_Listを以下の様に改造します。
（本当は引数を「Backup_Folder_File」のように変数名を明確に表現した方が良いと思います。その場合は、当然関数の引数部分も「Function File_List(Backup_Folder_File) As Variant」と改造して下さい）
  1. 　Buf = Dir(Backup_Folder)　　　　 '←関数を呼び出す側でファイル名までを指定
図４－３

そして呼び出す側は以下のように改造します。（赤字部分＋取り消し線で消したコードは削除）
  1. Sub Back_Up()
  2. 　Dim Backup_Folder As String　　　　 '←バックアップファイルを入れるフォルダー
  3. 　Dim Backup_File_Name As String　　 '←日付をつけたバックアップファイル名（フルパス）
  4. 　Dim Interval As Long　　　　 '←バックアップをする周期（日数）
  5. 　Dim FL As Variant　　　　　 '←バックアップフォルダのファイルリストの配列
  6. 　Dim FN As Variant　　　　 '←バックアップフォルダのファイル名＋拡張子の配列
  7. 　Dim FSO As Object　　　　　 '←ファイルコピーのオブジェクト
  8. 　Dim ThisFile As Variant　　　　 '←コピー元ファイル（本ブック）のファイル名＋拡張子の配列
  9. 　Dim Hizuke As String　　　　　 '←既存ファイルのファイル名についている日付部分
  10. 　Dim File_Date As Date　　　　　 '←ファイル名についている日付
  11. 　Dim cnt As Long　　　　　　 '←カウンター
  13. 　Set FSO = CreateObject("Scripting.FileSystemObject")　　　' ←ファイルコピーのオブジェクトのインスタンス化
  15. 　Interval = 2　　　 '←バックアップをする周期（日数）
  16. 　Backup_Folder = ThisWorkbook.Path & "¥bak"　　 '←バックアップフォルダー(フルパスで指定してあげて下さい)
  17. 　ThisFile = File_Name_Split(ThisWorkbook.Name)　 '←ｺﾋﾟｰ元ﾌｧｲﾙ(本ﾌﾞｯｸ)をﾌｧｲﾙ名本体+拡張子の配列にする
  19. 　If Dir(Backup_Folder, vbDirectory) = "" Then　　 '←バックアップのフォルダの有無を確認
  20. 　　MkDir Backup_Folder　　　　 '←フォルダが無かったら作る
  21. 　End If
  23. 　FL = File_List(Backup_Folder & "¥" & ThisFile(1) & "(*)" & ThisFile(2))　 '←ﾌｧｲﾙ名まで指定
  25. 　File_Date = 0　　　　 '←ﾌｧｲﾙ名の中の日付の初期値設定(0＝1900/1/1の前日)
  26. 　If IsEmpty(FL) = False Then　　　　　　 '←ﾊﾞｯｸｱｯﾌﾟﾌｫﾙﾀﾞ内がカラだったらﾊﾞｯｸｱｯﾌﾟﾌｧｲﾙ作成へ飛ぶ
  27. 　　For cnt = 1 To UBound(FL, 1)　　　　　 '←存在するﾌｧｲﾙ数分だけForを回す
  28. 　　　'FN = File_Name_Split(FL(cnt))　　　 '←ﾌｧｲﾙ名本体＋拡張子に分ける
  29. 　　　'If (ThisFile(1) = Left(FN(1), Len(ThisFile(1)))) And (ThisFile(2) = FN(2)) Then　　　 '←ﾌｧｲﾙ名(前半)と拡張子を比較
  30. 　　　　Hizuke = Mid(FL(1), Len(ThisFile(1)) + 2, 10)　　　 '←ﾌｧｲﾙ名から日付部分を取り出す
  31. 　　　　If IsDate(Hizuke) Then　　　　 '←日付部分が本当に日付型か確認
  32. 　　　　　If DateValue(Hizuke) > File_Date Then　　　　 '←より大きな(新しい)日付かを確認
  33. 　　　　　　File_Date = DateValue(Hizuke)　　　　 '←変数により大きな(新しい)日付を代入
  34. 　　　　　End If
  35. 　　　　End If
  36. 　　　'End If
  37. 　　Next cnt
  38. 　End If
  40. 　If DateDiff("d", File_Date, Date) >= Interval Then　　 '←今日の日付と比べてｲﾝﾀｰﾊﾞﾙ日数分より多いか確認
  41. 　　Backup_File_Name = Backup_Folder & "\" & ThisFile(1) & Format(Date, "(yyyy-mm-dd)") & ThisFile(2)
  42. 　　　　　　　'↑ 今日の日付を足した新ﾌｧｲﾙ名を設定
  43. 　　On Error Resume Next　　　　 '←ｺﾋﾟｰでｴﾗｰが出ても進める
  44. 　　　FSO.CopyFile ThisWorkbook.FullName, Backup_File_Name, True　　　 '←ﾊﾞｯｸｱｯﾌﾟﾌｧｲﾙをｺﾋﾟｰする
  45. 　　　If Err.Number <> 0 Then MsgBox ("ファイルバックアップに失敗しました")　　 '←ｺﾋﾟｰでｴﾗｰが出たらｺﾒﾝﾄを出す
  46. 　　On Error GoTo 0
  47. 　End If
  48. 　Set FSO = Nothing
  49. End Sub
図４－３

３０行目でFNをFLに変更しているのは、直前の２８行目でのFN（File　Name）配列を取り出すコードを削っただけでなく、図３－１のコードでFLを使用してしまうと、拡張子まで拾ってしまう為です。（結果は変わりませんが・・・）

５．ファイル名をファイル名本体と拡張子に分解

５－１．Split関数で分解する方法

図３－１のメインプロシージャ内の、１７行目および２８行目で使用している自作関数 File_Name_Splitは、「ファイル名をファイル名本体＋拡張子に分解」する関数です。
  1. Function File_Name_Split(file_name) As Variant
  2. 　Dim Buf As Variant
  3. 　Dim File_Array(1 To 2)　　　 '←1にファイル名本体、2に拡張子　を格納する配列
  5. 　Buf = Split(file_name, ".")　　 '←「.」で分割したファイル名を格納した配列
  6. 　If UBound(Buf, 1) > 0 Then
  7. 　　File_Array(2) = "." & Buf(UBound(Buf, 1))　　 '←拡張子部分
  8. 　End If
  9. 　File_Array(1) = Left(file_name, Len(file_name) - Len(File_Array(2)))　 '←拡張子を除いたファイル名本体
  11. 　File_Name_Split = File_Array
  12. End Function
図５－１

引数で指定されたファイル名 file_nameは、通常「abcd.xlsm」の様な形であり、ピリオドで分割されて、ファイル名本体「abcd」と拡張子「xlsm」に分割できます。ですので、入れ物として
　ファイル名本体　(1)　　　拡張子　　　(2)
のような配列を考えました。図５－１の３行目では　Dim File_Array(1 To 2)　として設定しています。

５行目ではSplit関数でファイル名をピリオドで分割しています。Split関数は第二引数で指定した文字列で分割をし配列に格納しますので、通常の「abcd.xlsm」のようなファイル名であれば、そのままファイル本体と拡張子の２つに分けられた配列として返すことが出来ます。

しかしファイル名には様々なものがあります。
１つは、①拡張子の無いもの（例：abcdefg）です。ピリオドがありませんので５行目のSplit関数の返り値（＝Buf）は、Buf(0)に全てのファイル名が格納され、６行目のUbound(Buf,1)はゼロになります。
また、②ピリオドが複数存在するもの（例：abcd.efgh.ijk.xlsm）では、Split関数４つのインデックスに分けられた配列を返し、Ubound(Buf,1)は（ゼロから開始するため）３になります。
またまた、③最後がピリオドのもの（例：abcdefg.）の場合は、Split関数の返り値は、Buf(1)が空（""）となりUbound(Buf,1)は２の値となります。

ファイル名の比較をするのですから、上記の①と③は違うものと判断できるようにする必要があります。ですから７行目の通り、拡張子側の配列にはピリオドも含めた拡張子を格納することにしました。
尚、Buf(UBound(Buf, 1)) はBuf配列の最後の入れ物を示しているので拡張子（または空欄）が格納されています。

９行目ではファイル名全体から拡張子部分を差し引いた部分をファイル名本体側の配列に格納し、１１行目で自作関数の返り値にして関数を終了します。

５－２．InStrRev関数で分解する方法

ファイル名を本体と拡張子に分割する方法はSplit関数だけではありません。InStr関数は文字列の先頭から検索文字列を探していく関数ですが、後ろから探す関数としてInStrRev関数というものがあり、拡張子探しには適していそうです。
「後ろから探す」といっても、検索文字列が存在する位置までを後ろから数えるのでは無く、InStrと同様に前方からの位置になります。

図５－１のコードと異なるのは、５行目でピリオドの位置を探し、７行目で拡張子部分を取り出している部分です。
尚、ピリオドが無いファイル名の場合は InStrRevの返り値はゼロとなりますので、その場合の関数返り値の配列の拡張子部分は空になります。
  1. Function File_Name_Split(file_name) As Variant
  2. 　Dim Period As Variant
  3. 　Dim File_Array(1 To 2)　　　 '←1にファイル名本体、2に拡張子　を格納する配列
  5. 　Period = InStrRev(file_name, ".")　　 '←「.」で分割したファイル名を格納した配列
  6. 　If Period > 0 Then
  7. 　　File_Array(2) = Mid(file_name, Period)　　　 '←拡張子部分
  8. 　End If
  9. 　File_Array(1) = Left(file_name, Len(file_name) - Len(File_Array(2)))　　 '←拡張子を除いたファイル名本体
  11. 　File_Name_Split = File_Array
  12. End Function
図５－２

６．さいごに

添付ファイルは、上記マクロを記入したファイルです。ワークシートには何もありませんのでバックアップする意味はありませんが、動作確認をしたい方は試してみて下さい。

自動バックアップファイル（it-013.xlsm）

セキュリティ向上を目的として「インターネット経由でダウンロードしたOfficeファイル（Excel等）のマクロは、既定でブロック」されるようにOfficeアプリケーションの既定動作が変更になりました。（2022年4月より切替開始）
解除の方法については「ダウンロードファイルのブロック解除方法」を参照下さい。