Last active
May 30, 2024 11:36
-
-
Save ExcelRobot/05fd96ccab28b398d6a9a46191693c72 to your computer and use it in GitHub Desktop.
Backup And Save Active Workbook VBA Macro
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
'--------------------------------------------< OA Robot >-------------------------------------------- | |
' Command Name: Backup And Save Active Workbook | |
' Description: Saves the active workbook, but also makes a backup in the Archive folder | |
' Macro Expression: modWorkbook.BackupAndSaveActiveWorkbook() | |
' Author: Excel Robot (@ExcelRobot) | |
' Generated: 08/05/2022 02:32 PM | |
'---------------------------------------------------------------------------------------------------- | |
Sub BackupAndSaveActiveWorkbook() | |
Dim archivePath As String | |
Dim wbName As String | |
Dim archiveFilename As String | |
' If this is a sharepoint file, don't bother | |
If Left(ActiveWorkbook.Path, 4) = "http" Then | |
ActiveWorkbook.Save | |
Exit Sub | |
End If | |
' If the Archive folder doesn't already exist, create it | |
archivePath = Replace(ActiveWorkbook.Path & "\Archive", "\\", "\") | |
If Dir(archivePath, vbDirectory) = "" Then | |
MkDir archivePath | |
End If | |
wbName = ActiveWorkbook.Name | |
' If this is a never saved workbook like Book1, then use sendkeys to trigger Save As dialog | |
If InStr(1, wbName, ".") = 0 Then | |
SendKeys "%f", True | |
SendKeys "a", True | |
SendKeys "o" | |
Else | |
' Name the archive file with datetime stamp before extension. | |
archiveFilename = Left(wbName, InStrRev(wbName, ".") - 1) | |
archiveFilename = archiveFilename & " v" & Format(Now(), "yyyy.MM.dd.hhmm") | |
archiveFilename = archiveFilename & Mid(wbName, InStrRev(wbName, ".")) | |
' Save the archive copy | |
ActiveWorkbook.SaveCopyAs archivePath & "\" & archiveFilename | |
' Also just save the file | |
ActiveWorkbook.Save | |
End If | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
For best results, assign this macro to the keyboard shortcut Ctrl-S so that every time you save, you will get a backup copy of the file tucked away in an Archive folder just in case you need it!