VBA使用頻度の高いコード(4):エクセルファイル更新バックアップ
エクセルファイル更新バックアップ
エクセルファイル更新バックアップ用コード
===============================
Sub データバックアップ更新()
'
Dim backupcheck As String
Dim CurrentPath, CurrentFile, ckBackup As String
Dim pPoint, BaseFilename, newFilename
' エラー時は強制終了
On Error GoTo ErrorProcess
ckBackup = MsgBox("更新バックアップします", vbOKCancel)
If (ckBackup = vbCancel) Then
Exit Sub
End If
' データ更新
ActiveWorkbook.RefreshAll
' 更新時上書き
ActiveWorkbook.Save
' バックアップ
If (ckBackup = vbOK) Then
CurrentPath = ThisWorkbook.Path
CurrentFile = ActiveWorkbook.Name
pPoint = InStrRev(CurrentFile, ".")
BaseFilename = Left(CurrentFile, pPoint - 1)
'ファイル名
newFilename = CurrentPath & "\" & BaseFilename & Format(Now, "_yyyymmddhhnnss") & ".xlsm"
MsgBox (BaseFilename & Format(Now, "_yyyymmddhhnnss") & ".xlsmにバックアップ")
Set objFso = CreateObject("Scripting.FilesystemObject")
objFso.Copyfile CurrentPath & "\" & CurrentFile, newFilename
Set objFso = Nothing
Else
MsgBox ("バックアップ無し")
End If
Exit Sub
ErrorProcess:
MsgBox ("エラー発生、終了します")
End Sub
===============================