VBA100本ノック 20本目：ブックのバックアップ
１ 今回のお題
マクロブック(ThisWorkbook)と同じフォルダに"BACKUP"フォルダを作成し、
"BACKUP"に自身(ThisWorkbook)のバックアップを以下の名称で保存してください。
ブック名_yyyymmddhhmm.xlsm
マクロ終了時には元のブックが開いている状態にしてください。
※繰り返し実行を考慮
２ 今回のお題の意図
何度も差分BackUpを取る。
３ 回答
私の最初の回答
Sub ノック20本目_1() 'BackUPの元となるBookのPath、Nameを取得 CriteriaBookName = ThisWorkbook.Name CriteriaBookNameLeft = Left(CriteriaBookName, 4) CriteriaBookPath = ThisWorkbook.Path CriteriaBookFullPath = CriteriaBookPath & "\" & CriteriaBookName 'BackUP用のBookのPath、Nameを設定 SaveBookName = CriteriaBookNameLeft & "backup_" & Format(Date, "yyyymmdd") & Format(Now, "hhmm") & ".xlsm" SaveBookPath = (CriteriaBookPath & "\" & CriteriaBookNameLeft & "backup_" & Format(Date, "yyyymmdd") & Format(Now, "hhmm") & ".xlsm") 'ファイルを保存（強制上書き） Application.DisplayAlerts = False ThisWorkbook.SaveAs SaveBookPath Application.DisplayAlerts = True '元Bookを開く Workbooks.Open CriteriaBookFullPath 'BackUPしたBookを閉じる。 Workbooks(SaveBookName).Close End Sub
処理手順
１ 基準となるファイルのフォルダＰＡＴＨを取得する。今回はマクロＢＯＯＫの保存なので、拡張子は「.xlsm」なので、Left関数を使って拡張子を除いたファイル名を取得しました。
２ 保存用のＰＡＴＨを設定。ＢＯＯＫ名に「backup_」、日付、時間を追記して、保存先ＰＡＴＨを設定。
３ 名前を付けて保存（強制上書き）
４ 元のＢＯＯＫを開く。
５ BackUPしたBookを閉じる。
サイト管理者からのツッコミ
１ 「"BACKUP"フォルダを作成」が漏れています。
２ 「ブック名_…」これはバックアップなので自分自身の名前という事になります。
３ Now()には日付も入っています。
つまり、「マクロブック(ThisWorkbook)と同じフォルダに"BACKUP"フォルダを作成し」ここの部分を勘違いしていました。フォルダを作って、「"BACKUP"に自身(ThisWorkbook)のバックアップをブック名_yyyymmddhhmm.xlsmの名称で保存してください。」というお題からそれていました。
また、日付、時間の取得に「Format(Date, "yyyymmdd") & Format(Now, "hhmm")」と書いていたのですが、
これは「Format(Now, "yyyymmddhhmm")」で日付も取れるようです。勉強になりました。
ということで、フォルダを作成してそこに「ブック名_yyyymmddhhmm.xlsm」を保存するようにコードの書き直し。
上のコードを準用して作っていたのですが、SaveASで保存したＢＯＯＫのClose処理がＰＡＴＨを変更してもうまくいきません(;^ω^)。
なので、SaveCopyAsでＢＯＯＫを保存することにしました。
最終回答
Sub ノック20本目_2() 'BackUPの元となるBookのPath、Nameを取得 CriteriaBookName = ThisWorkbook.Name CriteriaBookNameLeft = Left(CriteriaBookName, 4) CriteriaBookPath = ThisWorkbook.Path CriteriaBookFullPath = CriteriaBookPath & "\" & CriteriaBookName 'BackUP用のフォルダを作る SearchFolder = CriteriaBookPath & "\BackUp" If Dir(SearchFolder, vbDirectory) = "" Then MkDir SearchFolder End If 'BackUP用のBookのPath、Nameを設定 SaveBookPath = (SearchFolder & "\" & CriteriaBookNameLeft & "backup_" & Format(Now, "yyyymmddhhmm") & ".xlsm") 'ファイルを保存 ThisWorkbook.SaveCopyAs SaveBookPath End Sub
処理手順
１ 基準となるファイルのフォルダＰＡＴＨを取得する。
２ /BackUpフォルダが存在しなければ作成する。
３ 保存用のＰＡＴＨを設定
４ ＢＯＯＫを保存
この方がコードがスマートですね！
４ 一言
ＦＳＯを使えばLeft関数を使わなくても拡張子を除いたフォルダが名が取得できるようです。なので、ＦＳＯを使用して書くのもありですね。
SaveASとSaveCopyAsの違い勉強になりました。SaveCopyAsなら、元ＢＯＯＫを開きなおさなくてもよい、保存したＢＯＯＫを閉じなくてもよい。いいことづくめです。
ではでは、この辺で(^^)/~~~
