Geminiと100本ノック 20本目：ブックのバックアップ

公開日：2025-05-13　最終更新日：2025-05-13

Geminiと100本ノック 20本目：ブックのバックアップ

AIのGeminiがVBA100本ノックに挑戦！

Googleが開発した生成AIモデルのGeminiにVBA100本ノックをやってもらいました。
AIがVBAをどこまで扱えるかの実証実験の20本目です。

2025年3月からGemsが無料で使えるようになりました。
そこで、独自に作成したGem（名前は「AI神髄VBA」改良を続けている）を使った回答も掲載しています。

VBA100本ノックの出題と解答

VBA100本ノック 20本目：ブックのバックアップ

・出題・頂いた回答・解説・補足・サイト内関連ページ

Geminiへの出題とGeminiの回答

前回まではGeminiの回答は、キャプチャ画像とそのテキストにしていましたが今回からはテキストのみにします。
Geminiの回答であるというエビデンスの意味でキャプチャを掲載していましたが、さすがにもう必要はないでしょう。

Geminiの回答 Geminiへの出題

マクロブック(ThisWorkbook)と同じフォルダに"BACKUP"フォルダを作成し、
"BACKUP"に自身(ThisWorkbook)のバックアップを以下の名称で保存してください。
ブック名_yyyymmddhhmm.xlsm
マクロ終了時には元のブックが開いている状態にしてください。
※繰り返し実行を考慮

はい、承知いたしました。マクロブックと同じフォルダに"BACKUP"フォルダを作成し、そこにタイムスタンプ付きで自身のバックアップ（.xlsm形式）を保存し、元のブックを開いたままにするVBAコードです。

以下のコードをThisWorkbookモジュールの標準モジュール（例: Module1）に貼り付けて実行してください。

VBA


        
          
            Sub CreateWorkbookBackup()


　　' 変数の宣言

　　Dim CurrentPath As String

　　Dim CurrentName As String

　　Dim BaseName As String

　　Dim PathSeparator As String

　　Dim BackupFolderPath As String

　　Dim Timestamp As String

　　Dim BackupFileName As String

　　Dim FullBackupPath As String


　　' 1. 現在のブックのパスとファイル名を取得

　　CurrentPath = ThisWorkbook.Path

　　CurrentName = ThisWorkbook.Name


　　' ブックが保存されていない場合は終了

　　If CurrentPath = "" Then

　　　　MsgBox "このブックはまだ保存されていません。先に保存してください。", vbExclamation

　　　　Exit Sub

　　End If


　　' 拡張子なしのブック名を取得

　　' ファイル名の最後のドットの位置を検索

　　Dim LastDotPos As Long

　　LastDotPos = InStrRev(CurrentName, ".")


　　If LastDotPos > 1 Then ' ドットがあり、その前に文字がある場合

　　　　BaseName = Left(CurrentName, LastDotPos - 1)

　　Else ' ドットがない場合 (通常はあり得ないが念のため)

　　　　BaseName = CurrentName

　　End If


　　' 2. バックアップフォルダのパスを定義

　　' OSに応じてパス区切り文字を取得 ("\" または "/")

　　PathSeparator = Application.PathSeparator

　　BackupFolderPath = CurrentPath & PathSeparator & "BACKUP"


　　' 3. バックアップフォルダが存在しない場合は作成

　　If Dir(BackupFolderPath, vbDirectory) = "" Then

　　　　On Error Resume Next ' フォルダ作成時のエラーを無視 (権限がない場合など)

　　　　MkDir BackupFolderPath

　　　　On Error GoTo 0 ' エラーハンドリングを解除

　　　　' フォルダ作成が成功したか再確認

　　　　If Dir(BackupFolderPath, vbDirectory) = "" Then

　　　　　　 MsgBox "バックアップフォルダ '" & BackupFolderPath & "' を作成できませんでした。", vbExclamation

　　　　　　 Exit Sub

　　　　End If

　　End If


　　' 4. 現在の日時を取得し、指定された形式でタイムスタンプを生成

　　Timestamp = Format(Now, "yyyymmddhhmm")


　　' 5. バックアップファイルのファイル名とフルパスを構築

　　' 要求されている通り、拡張子は常に .xlsm とする

　　BackupFileName = BaseName & "_" & Timestamp & ".xlsm"

　　FullBackupPath = BackupFolderPath & PathSeparator & BackupFileName


　　' 6. ブックのコピーを指定したパスに保存

　　' SaveCopyAsを使用すると、元のブックは閉じずに開いたままになります。

　　On Error Resume Next ' 保存時のエラーを無視 (ファイルが使用中の場合など)

　　ThisWorkbook.SaveCopyAs FullBackupPath

　　Dim SaveError As Long

　　SaveError = Err.Number

　　On Error GoTo 0 ' エラーハンドリングを解除


　　' 7. 結果をユーザーに通知 (任意)

　　If SaveError = 0 Then

　　　　' バックアップが成功した場合のメッセージ (必要なければコメントアウト)

　　　　' MsgBox "バックアップが完了しました:" & vbCrLf & FullBackupPath, vbInformation

　　Else

　　　　' バックアップに失敗した場合のメッセージ

　　　　MsgBox "バックアップの保存中にエラーが発生しました (エラーコード: " & SaveError & ")。" & vbCrLf & _

　　　　　　　 "保存先: " & FullBackupPath, vbCritical

　　End If


　　' SaveCopyAsを使用しているので、元のブックは開いたままです。


            End Sub

コードの解説:

ThisWorkbook.Path: マクロが記述されているブックが保存されているフォルダのパスを取得します。ブックが一度も保存されていない場合は空文字 ("") を返します。
ThisWorkbook.Name: マクロが記述されているブックのファイル名を取得します。
拡張子なしの名前取得: InStrRev関数を使ってファイル名の最後のドットの位置を見つけ、Left関数で拡張子を除いた部分を取得します。
Application.PathSeparator: オペレーティングシステムに応じた適切なパス区切り文字（Windowsなら\、Macなら/）を取得します。これにより、どの環境でも正しく動作します。
BackupFolderPath: 取得したパスと"BACKUP"フォルダ名を組み合わせて、バックアップフォルダのフルパスを生成します。
Dir(BackupFolderPath, vbDirectory): 指定したパスにディレクトリ（フォルダ）が存在するか確認します。存在しない場合は空文字 ("") を返します。
MkDir BackupFolderPath: 指定したパスに新しいフォルダを作成します。On Error Resume NextとOn Error GoTo 0で挟むことで、フォルダ作成に失敗した場合（例: 権限がない）でもマクロが停止しないようにしています。
Format(Now, "yyyymmddhhmm"): 現在の日時を取得し、yyyymmddhhmm形式の文字列にフォーマットします。これにより、実行するたびに異なるファイル名が生成され、以前のバックアップが上書きされることを防ぎます。
BackupFileName: 拡張子なしのブック名、アンダースコア、タイムスタンプ、そして.xlsmを組み合わせて、バックアップファイルのファイル名を生成します。要求に合わせて拡張子は.xlsmに固定しています。
FullBackupPath: バックアップフォルダのパスとバックアップファイルのファイル名を組み合わせて、保存先のフルパスを生成します。
ThisWorkbook.SaveCopyAs FullBackupPath: SaveCopyAsメソッドを使用して、現在のブックのコピーを指定したパスに保存します。このメソッドの重要な点は、元のブックは閉じられずにそのまま開いた状態を維持することです。
エラーハンドリング: SaveCopyAsの実行中にもOn Error Resume Nextを使用し、保存に失敗した場合（例: 指定されたファイルが別のプロセスで使用されている）でもマクロが停止しないようにしています。エラーが発生した場合は、Err.Numberでエラーコードを取得できます。
完了メッセージ: バックアップが成功または失敗した場合に、必要に応じてメッセージボックスでユーザーに通知します（成功時のメッセージはコメントアウトしています）。

使用方法:

VBAエディタを開きます (Alt + F11)。
左側のプロジェクトエクスプローラーで ThisWorkbook を展開します。
標準モジュールを挿入します (右クリック -> 挿入 -> 標準モジュール)。
新しいモジュールに上記のコードを貼り付けます。
このマクロを実行します (VBAエディタでコード内にカーソルを置いてF5キーを押すか、Excelに戻って開発タブからマクロを選択して実行)。

初回実行時には、マクロブックと同じフォルダにBACKUPフォルダが作成され、その中にブック名_yyyymmddhhmm.xlsmという名前でバックアップファイルが保存されます。元のブックは開いたままです。繰り返し実行しても、タイムスタンプが変わるため、新しいバックアップファイルが作成されます。

これは何も問題ないですね。
このような処理にせAIはあっさりVBAコードを書いてくれるようです。
SaveCopyAsメソッドの選択も適切です。

AI神髄VBAへの出題とAI神髄VBAの回答

AI神髄VBAとは、GeminiのGems機能を使って作ったVBAに特化したカスタムAIです。

AI神髄VBAの回答 AI神髄VBAへの出題

はい、承知いたしました。マクロブックと同じフォルダに"BACKUP"フォルダを作成し、自身を日時付きファイル名でバックアップ保存するVBAコードを提案します。エラーハンドリングにより、既に"BACKUP"フォルダが存在する場合も問題なく動作します。

VBA


        
          
            ' 概要：自身のブックをマクロブックと同階層の"BACKUP"フォルダに日付時刻付きでバックアップ保存します。

Sub BackupThisWorkbook()


　　' エラー発生時に処理を続行（主にフォルダ作成時のエラーを無視するため）

　　On Error Resume Next


　　' マクロブックのフルパスからフォルダパスを取得

　　Dim originalPath As String

　　originalPath = ThisWorkbook.Path


　　' バックアップフォルダのフルパスを作成

　　Dim backupFolderPath As String

　　backupFolderPath = originalPath & "\BACKUP"


　　' バックアップフォルダを作成

　　' 既に存在する場合はエラーとなるが、On Error Resume Next により無視されます

　　MkDir backupFolderPath


　　' エラーハンドリングを通常に戻す

　　On Error GoTo 0


　　' 元のブック名から拡張子を除いた名前を取得

　　' 例: MyBook.xlsm -> MyBook

　　Dim originalNameWithoutExt As String

　　originalNameWithoutExt = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)


　　' 現在の日時を "yyyymmddhhmm" 形式で取得

　　Dim dateTimeString As String

　　dateTimeString = Format(Now, "yyyymmddhhmm")


　　' バックアップファイル名を生成

　　' 例: MyBook_202310271530.xlsm

　　Dim backupFileName As String

　　backupFileName = originalNameWithoutExt & "_" & dateTimeString & ".xlsm"


　　' バックアップファイルのフルパスを作成

　　Dim backupFilePath As String

　　backupFilePath = backupFolderPath & "\" & backupFileName


　　' 自身のブックを指定したパスにバックアップとして保存

　　' SaveCopyAsメソッドは元のブックを閉じずにコピーを作成します

　　ThisWorkbook.SaveCopyAs backupFilePath


　　' これでバックアップが作成され、元のブックは開いたままです


End Sub

コード解説:

Sub BackupThisWorkbook(): このプロシージャがバックアップ処理を実行します。
On Error Resume Next: エラーが発生しても処理を中断せず、次の行に進むように設定します。これは、MkDirで既に存在するフォルダを作成しようとした場合に発生するエラーを無視するために使用しています。
originalPath = ThisWorkbook.Path: 実行中のマクロブックが存在するフォルダのパスを取得します。
backupFolderPath = originalPath & "\BACKUP": 取得したフォルダパスに"\BACKUP"を結合し、バックアップフォルダのフルパスを作成します。
MkDir backupFolderPath: 指定したパスにフォルダを作成します。既に同名のフォルダが存在する場合、ここでエラーが発生しますが、On Error Resume Nextによって無視されます。
On Error GoTo 0: エラーハンドリングをデフォルトの状態（エラー発生時にプロシージャを中断）に戻します。
originalNameWithoutExt = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1): ThisWorkbook.Nameでブック名（拡張子含む）を取得し、InStrRevで最後の"."の位置を検索、Left関数でその位置より左側の文字列（拡張子を除いたブック名）を取得しています。
dateTimeString = Format(Now, "yyyymmddhhmm"): 現在の日時をyyyymmddhhmmの形式にフォーマットした文字列を取得します。
backupFileName = originalNameWithoutExt & "_" & dateTimeString & ".xlsm": 拡張子を除いたブック名、アンダースコア、日時文字列、拡張子(.xlsm)を結合し、バックアップファイルのファイル名を作成します。
backupFilePath = backupFolderPath & "\" & backupFileName: バックアップフォルダのパスとバックアップファイル名を結合し、保存先のフルパスを作成します。
ThisWorkbook.SaveCopyAs backupFilePath: 実行中のマクロブック自身のコピーを指定したフルパスで保存します。SaveCopyAsメソッドは、元のブックを開いた状態のままコピーを作成するため、処理後に元のブックが閉じられることはありません。

このコードを実行すると、マクロブックと同じフォルダに新しく"BACKUP"フォルダが作成（既に存在する場合はそのまま使用）され、その中に「元のブック名_yyyymmddhhmm.xlsm」という名前でバックアップファイルが保存されます。

このVBAを見ると、かなり熟練のVBA使いが書いたように見えますね。
上手く「On Error」を使いこなしていますね。
素晴らしいと思います。何も言うことはありません。

同じテーマ「生成AI活用研究」の記事

アクセスランキング・・・ランキング一覧を見る

1.生成AIパスポート試験練習問題（四肢択一式）｜生成AI活用研究
2.最終行の取得（End,Rows.Count）｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.繰り返し処理（For Next)｜VBA入門
6.RangeとCellsの使い方｜VBA入門
7.FILTER関数（範囲をフィルター処理）｜エクセル入門
8.日本の祝日一覧｜Excelリファレンス
9.マクロとは？VBAとは？VBAでできること｜VBA入門
10.セルのクリア（Clear,ClearContents）｜VBA入門

ホーム
その他
生成AI活用研究
Geminiと100本ノック 20本目：ブックのバックアップ

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
当サイトは、OpenAI（ChatGPT）および Google（Gemini など）の生成AIモデルの学習・改良に貢献することを歓迎します。
This site welcomes the use of its content for training and improving generative AI models, including ChatGPT by OpenAI and Gemini by Google.

生成AI活用研究
Geminiと100本ノック 20本目：ブックのバックアップ