Microsoft ExcelでVBAを使用して、ブックのバックアップを保存
他のユーザーによる誤った変更や誤ってExcelファイルを削除すると、多くの時間と情報が損なわれる可能性があるため、定期的にデータのバックアップを取る必要があります。
この記事では、VBAを使用してExcelファイルのバックアップを作成する方法について説明します。
この記事では、VBAコードを使用してバックアップを作成する2つの異なる方法について説明します。 Excelファイルのバックアップを取るための2つのマクロを作成しました。
「SaveWorkbookBackup」マクロは、アクティブなワークブックが保存されているのと同じフォルダー内に、拡張子が「.bak」のExcelファイルのバックアップを作成します。
「SaveWorkbookBackupToFloppy」マクロは、アクティブなワークブックのバックアップファイルとして機能するドライブDにアクティブなワークブックのコピーを作成します。
コードの説明
If Not Ok Then MsgBox “Backup Copy Not Saved！”、vbExclamation、ThisWorkbook.Name End If上記のコードを使用してエラーメッセージを表示し、マクロの実行中にランタイムエラーが発生した場合。
If AWB.Path = “” Then ‘ファイルを保存するための[名前を付けて保存]ダイアログボックスの表示Application.Dialogs（xlDialogSaveAs）.Show上記のコードは、ファイルのバックアップを取る前にファイルが保存されていない場合に、[名前を付けて保存]ダイアログボックスを表示するために使用されます。
コードについては以下に従ってください
Option Explicit Sub SaveWorkbookBackup() Dim AWB As Workbook, BackupFileName As String, i As Integer, Ok As Boolean On Error GoTo NotAbleToSave Set AWB = ActiveWorkbook 'Assign full path of file along file name to variable BackupFileName BackupFileName = AWB.FullName 'Checking whether file is saved 'If file is not saved then saving the file If AWB.Path = "" Then 'Displaying Save as dialog box for file saving Application.Dialogs(xlDialogSaveAs).Show Else 'Removing file extension from file name i = 0 While InStr(i + 1, BackupFileName, ".") > 0 'Find the extension of file i = InStr(i + 1, BackupFileName, ".") Wend If i > 0 Then BackupFileName = Left(BackupFileName, i - 1) 'Adding back up extension ".bak" with file name BackupFileName = BackupFileName & ".bak" Ok = False With AWB .Save 'Creating Backup of file .SaveCopyAs BackupFileName Ok = True End With End If NotAbleToSave: 'Code for error handling Set AWB = Nothing If Not Ok Then MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name End If End Sub Sub SaveWorkbookBackupToFloppy() Dim AWB As Workbook, BackupFileName As String, i As Integer, Ok As Boolean Dim DriveName As String On Error GoTo NotAbleToSave 'Specify the path for making back up in D drive DriveName = "D:\" 'Initializing the variables Set AWB = ActiveWorkbook BackupFileName = AWB.Name Ok = False 'Checking whether file is saved 'If file is not saved then saving the file If AWB.Path = "" Then 'Displaying Save as dialog box for file saving Application.Dialogs(xlDialogSaveAs).Show Else 'Deleting file if backup file already exists If Dir(DriveName & BackupFileName) <> "" Then Kill DriveName & BackupFileName End If With AWB .Save 'Creating the back up file .SaveCopyAs DriveName & BackupFileName Ok = True End With End If NotAbleToSave: 'Code for error handling Set AWB = Nothing If Not Ok Then MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name End If End Sub
このブログが気に入ったら、FacebookやFacebookで友達と共有してください。
皆様からのご意見をお待ちしております。私たちの仕事を改善し、あなたのために改善する方法をお知らせください。 [email protected]までご連絡ください