Updated VBA Backup code
November 9, 2009 • JP • No Comments • Rate This Article
• Links to this article
I've updated the backup code I presented in a previous post: A VBA Based Backup Solution
In addition to the existing function, this code will make copies of open files (of any type). So if you wanted to backup the currently open workbook, you can do that now. Or that .ppt file with next week's presentation, and so on. I've added better error handling as well. Below you will find the main procedure, along with all of the ancillary functions (except for BrowseForFolder which you'll need to get at VBA Express).
Note that we could also use the SaveCopyAs Method to make a copy of the active workbook, if we already knew the destination path (and only wanted to save workbooks).
Declare Function apiCopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
Sub BackupFile()
' make a copy of any file in any folder, even if open
On Error GoTo ErrorHandler
Dim todaysDate As String
Dim fileName As String
Dim fileType As String
Dim isOpen As Boolean
Dim extractedFileName As String
Dim wkb As Excel.Workbook
Dim fileFolder As String
' pad with space
Const BACKUP_FILE As String = " BACKUP "
' get current date and time
todaysDate = Format(Now, "MMDDYYYY HHMM")
' get full filepath of file to be copied
fileName = GetFileName
If fileName = "False" Then
MsgBox "No file selected, exiting now."
Exit Sub
End If
' get file extension
fileType = GetFileType(fileName)
' extract filename from drive letter and extension
extractedFileName = ExtractFileName(fileName)
' check if file is currently open
For Each wkb In Excel.Workbooks
If InStr(wkb.Name, extractedFileName) > 0 Then
isOpen = True
End If
Next
' browse for folder to place files
fileFolder = BrowseForFolder & Application.PathSeparator
If fileFolder = "False" Then
MsgBox "No folder chosen, no backup is being made."
Exit Sub
End If
' copy file to folder, complete with new name
' if file is open, use API call
If isOpen Then
Call apiCopyFile(fileName, fileFolder & extractedFileName & _
BACKUP_FILE & todaysDate & fileType, False)
Else
FileCopy fileName, fileFolder & extractedFileName & BACKUP_FILE & _
todaysDate & fileType
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Function GetFileName() As String
' returns filename to be backed up
Dim fileName As String
fileName = _
Application.GetOpenFilename("All Files (*.*), *.*", , "Choose File to Backup")
If fileName <> "False" Then
GetFileName = fileName
End If
End Function
Function ExtractFileName(fileName As String) As String
' extract filename portion of filename, no extension
Dim fileN As String
fileN = Right(fileName, Len(fileName) - InStrRev(fileName, "\"))
fileN = Replace(fileN, GetFileType(fileN), "")
ExtractFileName = fileN
End Function
Function GetFileType(fileName As String) As String
' get file extension
GetFileType = Mid$(fileName, InStrRev(fileName, "."), Len(fileName))
End Function
First we get the name of the file, using Excel's native dialog box. The GetFileName function uses the GetOpenFilename function to return a string with the path and filename of the file to be copied.
The filename is parsed to extract the filename portion and the extension, which we'll use later to build the new filename (with timestamp).
If copying a workbook, we cannot use FileCopy if it's already open. So we loop through the Workbooks collection to see if the filename matches any open workbook. If so, we use the API to copy the file. Instead of looping, I suppose we could just check if the file is an Excel type (if not, there's no point in looping the Workbooks collection). I have a function to do just that in this post.
If you select a workbook, the procedure checks if it's open, but doesn't check any other file type. If this procedure will be used mostly with non-Excel file types, just convert it to use the API exclusively.
Excel ·
Rate This Article:
(1 votes, average: 5.00 out of 5)
Loading ...What now?
Subscribe To The Blog
Email This Article
Follow Me On Twitter
My Facebook Page
Or just keep reading:
I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space if you want to learn more about VBA. Keep Reading »
Previous Post: Use textboxes like date or phone number fields
Next Post: Where's the link love?
Jimmy -
"just convert it to use the API exclusively."
Is there any reason not to use the API exclusively?
Not really, except as a looping exercise.