エクセル業務に役立つ！1クリックでバックアップ保存ができるVBA

豆父ちゃん

データ保存する時に自動的にバックアップを取りたい。なんかいい方法はないの？

こんな方のために、簡単にバックアップ保存できるVBAを紹介します。

バックアップ保存VBAとは

エクセルファイルを保存するときは名前をつけて保存、もしくは上書き保存をしている方がほとんどだと思います。

バックアップ保存VBAは1クリックで上書き保存＋バックアップフォルダに保存できるシステムです。

このシステムを使って保存をすれば、日頃使っているエクセルファイルが壊れたり消されたりしてもバックアップがあるので安心です。

下記で紹介するサンプルVBAの使い方はバックアップ用フォルダを作成し、そのフォルダの場所を登録するだけ。この設定を1度行うだけで毎回バックアップをとりながらデータ保存が可能になります。

適当な場所にフォルダを作成。この作成したフォルダにバックアップ用のデータがどんどん保存されていきます。

設定sheetに先程作成したフォルダの場所を指定します。既にあるフォルダに保存したい場合はそのフォルダの場所を指定してください。

ユーザーフォームでボタンを作成し、VBAを登録。実行すると指定したフォルダにエクセルファイルが保存されます。

エクセルファイルがどのように使われているかでVBAの実行方法が異なります。サンプルではユーザーフォームでVBAを実行させていますが、他にも任意のセルをクリックして実行、ボタンを作成して実行などいろんな方法があります。

下記の記事ではVBAの実行について詳しく紹介しています。

バックアップVBAをどのように実行方法させればよいか迷っている方は参考にしてみてください。

サンプルVBAをコピーするだけですぐにあなたのエクセルファイルで使うことができます。バックアップ保存しなければならない重要なエクセルファイルへ導入してみましょう。

1	Sub 年別バックアップ()
2	Application.ScreenUpdating = False
3	Dim Ash As Worksheet
4	Set Ash = Worksheets(“設定")
5	Dim FName, FPath, BFolder, SaveBackupFolder, SaveFolder As String
6	Dim Ye As Long
7	Ye = Year(Now)
8	FName = ThisWorkbook.Name
9	FPath = ActiveWorkbook.Path
10	BFolder = Ash.Cells(3, 2)
11	If Dir(BFolder, vbDirectory) = “" Then
12	MsgBox “フォルダは存在しません。"
13	Exit Sub
14	End If
15	SaveBackupFolder = BFolder & “\" & “(" & Ye & “年)" & FName
16	SaveFolder = FPath & “\" & FName
17	Application.DisplayAlerts = False
18	ThisWorkbook.SaveAs SaveBackupFolder
19	ThisWorkbook.SaveAs SaveFolder
20	Application.DisplayAlerts = True
21	End Sub

1	Sub 月別バックアップ()
2	Application.ScreenUpdating = False
3	Dim Ash As Worksheet
4	Set Ash = Worksheets(“設定")
5	Dim FName, FPath, BFolder, SaveBackupFolder, SaveFolder As String
6	Dim Ye, Mo As Long
7	Ye = Year(Now)
8	Mo = Month(Now)
9	FName = ThisWorkbook.Name
10	FPath = ActiveWorkbook.Path
11	BFolder = Ash.Cells(3, 2)
12	If Dir(BFolder, vbDirectory) = “" Then
13	MsgBox “フォルダは存在しません。
14	Exit Sub
15	End If
16	SaveBackupFolder = BFolder & “\" & “(" & Ye & “年" & Mo & “月)" & FName
17	SaveFolder = FPath & “\" & FName
18	Application.DisplayAlerts = False
19	ThisWorkbook.SaveAs SaveBackupFolder
20	ThisWorkbook.SaveAs SaveFolder
21	Application.DisplayAlerts = True
22	End Sub

1	Sub 日別バックアップ()
2	Application.ScreenUpdating = False
3	Dim Ash As Worksheet
4	Set Ash = Worksheets(“設定")
5	Dim FName, FPath, BFolder, SaveBackupFolder, SaveFolder As String
6	Dim Ye, Mo, Da As Long
7	Ye = Year(Now)
8	Mo = Month(Now)
9	Da = Day(Now)
10	FName = ThisWorkbook.Name
11	FPath = ActiveWorkbook.Path
12	BFolder = Ash.Cells(3, 2)
13	If Dir(BFolder, vbDirectory) = “" Then
14	MsgBox “フォルダは存在しません。"
15	Exit Sub
16	End If
17	SaveBackupFolder = BFolder & “\" & “(" & Ye & “年" & Mo & “月" & Da & “日)" & FName
18	SaveFolder = FPath & “\" & FName
19	Application.DisplayAlerts = False
20	ThisWorkbook.SaveAs SaveBackupFolder
21	ThisWorkbook.SaveAs SaveFolder
22	Application.DisplayAlerts = True
23	End Sub