FIGURE 6:
Semi-automatically filling in Enum
values.I'm pretty sure everybody who uses computers has, at some time, lost hours of work, either because of a crashing application or operating system, or as the result of a dying hard disk. If you're one of the lucky exceptions, your time will come. Guaranteed!
Unfortunately, none of the Office applications come with an option to create safety copies of your current work. Even Word's Always create backup copy option in the Options dialog box (select Tools | Options, then the Save tab) only creates a copy in the same folder as the original document, so in case of a hard disk crash, you're still left without a backup.
The only safe place for creating backups of your documents is either on a disk that you can take out of your PC (and away from your office), or on a different computer. Now that removable drive systems are among the most popular PC peripherals, and many people have both a desktop and a portable PC, there's no excuse for losing your work because of a system failure.
So let's take a closer look at ways to back up your work. Of course, you can run third-party backup programs, but they have the drawback that you must stop working on your documents, exit your application, and walk your dog for an hour or so. Wouldn't it be convenient to have a way to create backups while you work, and - more importantly - perform those BUWYWs automatically as a background task?
It can be done, but not without a bit of hacking. In this installment of a two-part series, I'll show you how you can auto-save your documents, workbooks, and presentations in two different locations, without interrupting your work. Next month, I'll even give you a way to create those BUWYWs in space-saving ZIP files.
Poor Man's Backups
There are - in theory - a few ways to programmatically create a copy of a document. VBA comes with a FileCopy statement, which uses the following syntax:
FileCopy Source, Destination
It works if you want to copy a file you're not working on, but if you try to use FileCopy on an open file, you're guaranteed to get a Permission Denied error. So that's a no-go for a BUWYW solution. (Strangely enough, in 16-bit Word, versions 2 and 6, you could use FileCopy with active Word documents. For some unclear reason, Microsoft removed that option with the 32-bit 95 and 97 versions.)
Another poor man's solution would be to use the SaveAs method. In Word, you can perform a BUWYW with the following code:
CurPath = ActiveDocument.FullName
ActiveDocument.SaveAs "E:\MyBackups\" &
ActiveDocument.Name
ActiveDocument.Close
Documents.Open CurPath
Apart from the fact that this is highly inelegant, it also has the drawback that the last instruction doesn't take you back to the location in the document where you left off. (In Word, you can use the GoBack method to do this, but Excel and PowerPoint don't have such a feature.)
So, what's the next option? VBA doesn't offer one. The Windows API comes with a CopyFile function, but don't even bother trying it. CopyFile is just an anagram of FileCopy - and comes back with the same Permission Denied error if you try it with a document that's open in an application.
Does this mean that a true BUWYW solution is simply impossible? No. But I only found out by accident.
SHFileOperation to the Rescue
Bruce McKinney's excellent book, Hardcore Visual Basic [Microsoft Press, 1997], pointed me in the direction of the SHFileOperation API function. It's a highly multi-functional beast that copies, renames, deletes, and moves files, and offers all sorts of safeguards and status reports. When I decided to try this function as a way to create a BUWYW application, I didn't give it much chance. Imagine my surprise and joy when I found out that it worked perfectly! Testing it with Word, Excel, and PowerPoint files that were open on my screen proved that this is probably the only Windows function that can copy a file in use by an application.
Implementing SHFileOperation.
SHFileOperation is one of those Windows functions that wants to receive its parameters in the form of a structure. In a VBA project, you format this structure (called SHFILEOPSTRUCT) as follows:
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
The SHFileOperation
function itself is declared like this:
Declare Function
SHFileOperation Lib _
"shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As
Long
When you call this function, you pass it the required parameters by assigning values to the relevant members of the SHFILEOPSTRUCT structure. Some of the values you specify are default Windows constants. The ones we use for our BUWYW project are the following:
Const FO_COPY = &b
Const FOF_NOCONFIRMATION =
&H10
Const FOF_NOCONFIRMMKDIR =
&b00
Const FOF_MULTIDESTFILES =
&H1
The SHFileOperation function returns zero if successful, or non-zero if an error occurs. (Note: you must have at least Windows 95 or NT 4.0; the SHFileOperation function didn't exist in NT 3.51.)
Backing up the current document. The sample macro in FIGURE 1 demonstrates how easy it is to fill the SHFILEOPSTRUCT structure with values.
Sub BackupThisDocument()
Dim fo As SHFILEOPSTRUCT
With fo
.wFunc = FO_COPY
.pFrom =
ActiveDocument.FullName
.pTo = "E:\My
Backups\" & ActiveDocument.Name
.fFlags =
FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION
End With
Call SHFileOperation(fo)
End Sub
FIGURE 1: Filling the SHFILEOPSTRUCT with values.
As it turns out, we can safely ignore half of the parameters, and deal only with the wFunc, pFrom, pTo, and fFlags members. We specify FO_COPY (decimal value 2) for wFunc to tell SHFileOperation that we want to copy a file. The pFrom parameter gets the value of the active Word document; the pTo parameter defines the destination file. In this example, it's a file with the same name as the current document, which will be copied to the E:\My Backups\ folder. Because we want our BUWYW activities to take place as a background task without disturbing our work, we use the two values for fFlags that trigger the function to hide any prompts:
That's it! With only a few lines of code, we have a BUWYW routine for Word that works as advertised. But that's only the start. Let's see how we can expand its features.
Making BUWYW work for any Office application.
In the previous example, we specified ActiveDocument.FullName as the value for pFrom. That works fine in Word, but obviously not in Excel or PowerPoint. One way to use this code in other Office applications would be to replace ActiveDocument.FullName with ActiveWorkbook.FullName or ActivePresentation.FullName as the parameter values for Excel and PowerPoint files, respectively. But that's a lot of double work that we would have to repeat for any other application Microsoft may add to the Office suite. A more efficient solution is to use the ActiveWindow object and look at the Parent property, which also gives us the name of the active file. The macro in FIGURE 2 works in all Office applications, and includes some code to bail out if there's no open window, or the active file hasn't been saved yet.
Sub BackupActiveFile()
'
Quit if there's nothing open.
If Windows.Count = 0 Then Exit Sub
' Set an object variable that refers to the active file.
Dim ThisFile As Object
Set ThisFile = ActiveWindow.Parent
' Bail out if the file hasn't been saved.
If ThisFile.Path = vbNullString Then
Exit Sub
' Copy it.
Dim fo As SHFILEOPSTRUCT
With fo
.wFunc = FO_COPY
.pFrom =
ThisFile.FullName
.pTo = "E:\My
Backups\" & ThisFile.Name
.fFlags =
FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION
End With
Call SHFileOperation(fo)
End Sub
FIGURE 2: How to back up the active file in any Office application.
Backing up all open files. The example in FIGURE 2 copies a single file: the active document, workbook, or presentation. SHFileOperation also supports copying multiple files in a single action. All it takes is a list of files we want to copy for the pFrom parameter, and a common destination folder for the pTo parameter. When we provide a list of files to copy, SHFileOperation wants them separated by null characters. The For Each loop in FIGURE 3 creates this list by walking through the collection of open windows. If the associated document has a valid path (i.e. if it's been saved before), it's added to the list, together with the vbNullChar constant. Because each Office application lets you open multiple windows for the same document (using the New Window command on the Window menu), the macro only adds the file name if it's not in the list, so the file won't be copied more than once.
Sub BackupAllOpenFiles()
Dim ThisFile As Object
' Loop through the list of open windows.
For Each aWin In Windows
' Get the document name associated with the window.
Set ThisFile = aWin.Parent
' See if the file has been saved before.
If ThisFile.Path <> vbNullString Then
' Get the full path name, add Chr(0) behind it.
strFullPath =
ThisFile.FullName & vbNullChar
' See if it is already in the list; if not, add it.
If InStr(strSource, strFullPath) = 0 Then
strSource =
strSource & strFullPath
End If
End If
Next
' Copy the files.
Dim fo As SHFILEOPSTRUCT
With fo
.wFunc = FO_COPY
.pFrom = strSource
.pTo = "E:\My
Backups\"
.fFlags =
FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION
End With
Call SHFileOperation(fo)
End Sub
FIGURE 3: How to back up an entire session.
Recreating the full path of a file on another drive. The previous examples copy one or all open documents to a single target folder (in this case, hard-coded as "E:\My Backups"). You may prefer a solution that actually stores the full path information of the file on the backup drive, so you know where to put it back in case you need to restore it, or copy it to another computer. For example, if the path of the current document is "C:\My Documents\MemoToBill.doc," you'd like to back it up as "E:\My Documents\MemoToBill.doc." That's rather simple. Look again at the BackupActiveFile routine shown in FIGURE 2. Now change the line that sets the value of the pTo parameter as follows:
.pTo = "E" & Mid(ThisFile.FullName, 2)
This instruction simply removes the first character from the full pathname of the active document, and replaces it with the letter "E" (which on my computer is the drive letter of a Jaz drive, but could also be the letter of a mapped network drive). The FOF_NOCONFIRMMKDIR part of the fFlags parameter makes sure that the full path is automatically recreated on the target drive if it doesn't exist.
Recreating the full path of all open files on another drive. Let's take this last example one step further. You want to create a BUWYW of all open documents, recreating each document's full path on the target drive. It's obvious we have to give the SHFileOperation function some additional information. We do this by including the FOF_MULTIDESTFILES value (decimal 1) in the fFlags parameter. This tells SHFileOperation that the pTo parameter specifies multiple destination files (one for each source file) rather than one directory where all source files are to be deposited. It's important to make sure the number and sequential order of the source files are the same as the number and order of the target files. The routine shown in FIGURE 4 (similar to the BackupAllOpenFiles routine shown earlier) takes care of this. In the loop that walks through all open windows, both a strSource and strTarget variable are filled with file names. (This routine assumes the backup drive has the letter E.)
Sub BackupAllFilesWithPath()
Dim ThisFile As Object
For Each aWin In Windows
' Get the document name associated with the window.
Set ThisFile = aWin.Parent
' See if the file has been saved before.
If ThisFile.Path <> vbNullString Then
' Get the full path name, add Chr(0) behind it.
strFullPath =
ThisFile.FullName & vbNullChar
' See if it is already in the list.
' If not, add it to the source list.
If InStr(strSource, strFullPath) = 0 Then
strSource =
strSource & strFullPath
' Add the destination of each file to
' the destination list.
strTarget =
strTarget & "E" & Mid(strFullPath, 2)
End If
End If
Next
Dim fo As SHFILEOPSTRUCT
With fo
.wFunc = FO_COPY
.pFrom = strSource
.pTo = strTarget
.fFlags =
FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION + _
FOF_MULTIDESTFILES
End With
Call SHFileOperation(fo)
End Sub
FIGURE 4: How to recreate the full path of each session file on a target drive.
Part One of the Backup Class
Now that you're familiar with the concept of copying one or more files to one or more destinations using the SHFileOperation function, we're ready to explore the Backup class, shown in Listing One. By including this class in your project, you can execute any sort of BUWYW operation with a few lines of macro code. Have a look at this sample:
With New
Backup
.BackupWhat = 1
.BackupWhere =
"E"
.SaveFirst = 0
.ShowStatus = True
.Execute
End With
All code that accesses the properties and methods of the Backup class is here, placed inside a With block. The New keyword creates a new instance of the Backup object. The With statement allows you to perform a series of statements on the object without repeatedly qualifying the name of the object.
The Backup class contains four properties and one method:
• 0 - Save each file before a backup is created. If the file hasn't been saved before, the application's Save As dialog box is displayed.
• 1 - Save only files that have been saved before. In other words, skip the files that don't live on your drive yet.
• 2 - Don't save. Only the last saved version (if available) is copied.
• If omitted, 0 is assumed.
The download file (see end of article for details) contains a number of demonstration macros that illustrate how to use these properties.
Inside the Backup Class
Much of the Execute function in the Backup class covers code previously discussed, but the references to the objFSO object variable may look unfamiliar. This variable points to the object created in the Class_Initialize routine (which runs each time you create a new instance of the Backup class). The responsible statement is:
Set objFSO = CreateObject("Scripting.FileSystemObject")
This instruction creates an instance of the FileSystemObject object, which is exposed by VBScript, a subset of the Visual Basic language contained in the SCRRUN.DLL file in the System or System32 subfolder of your main Windows folder. VBScript is automatically installed if you have Windows 95a or later, Windows NT 4 or later, Internet Explorer 3 or later, Internet Information Server 3 or later, the Windows Scripting host, Outlook 98, Visual Studio 98, or Office 2000. (I discussed VBScript in detail in "The Power of VBScript" in the May, 1999 issue of MOD; please refer to that article if you want to know more about the FileSystemObject properties and methods, and how you can use them in your VBA projects.) The FileSystemObject properties and methods used in the Execute function are shown in FIGURE 5.
|
Method/Property |
Action |
|
GetDriveName |
Returns a string containing the name of a drive or network share. |
|
BuildPath |
Combines a path name and file name to a fully qualified file path. |
|
DriveExists |
Returns True if a specified drive exists. |
|
IsReady |
For removable-media drives and CD-ROM drives, returns True only if the appropriate media is inserted and ready for access. |
|
DriveType |
Returns a numeric value: 0=Unknown, 1=Removable, 2=Fixed, 3=Network, 4=CD-ROM, 5=RAM Disk. |
FIGURE 5: FileSystemObject properties and methods used in the Execute function.
Discovering Enumeration constants
The other element in the Backup class listing that you may not have seen before is the Enum statement. Enumerations are a new feature in VBA for Office 2000. Their syntax is as follows:
Enum bkSave
bkAlways
bkOnlyIfSavedBefore
bkNever
End Enum
Enumerations provide a convenient way to work with sets of related constants and to associate constant values with names. Each Enum type consists of a name (bkSave in the previous listing), and one or more constant names and their associated constant values. By default, the first constant in an enumeration is initialized to the value 0, and subsequent constants are initialized to the value of one more than the previous constant. Hence, in the previous listing, bkAlways has the value 0, bkOnlyIfSavedBefore equals 1, and bkNever defaults to 2. (Note that the "bk" prefix in these constants is used to avoid possible conflicts with public Enum constants in other modules. You see a similar use of different prefixes when you open the Object Browser - "Wd" for Word constants, "Xl" for Excel constants, etc.)
The Backup class uses these collections of constants in two Property Let and Property Get pairs. The following pair is linked with the bkSave enumeration:
Property Get
SaveFirst() As bkSave
SaveFirst = lngSaveFirst
End Property
Property Let
SaveFirst(lngSave As bkSave)
lngSaveFirst = lngSave
End Property
When you include Enum types in a class, they become part of your project's type library. If you check Auto List Members in the Options dialog box (under the Tools menu) of the VB Editor, each list of constants is automatically displayed at the current insertion point when you are required to enter a related value. FIGURE 6 illustrates how this works when you create an instance of the Backup class.
FIGURE 6:
Semi-automatically filling in Enum
values.
Note: The download file contains a version of the Backup class that's optimized for Office 2000, but also has instructions on how to make the class work with Office 97 applications.
Conclusion
The purpose of this series is to demonstrate that the VBA programmer isn't necessarily limited to the standard features and functions that Microsoft provides. This article has shown that, with a bit of hacking, you can create powerful new tools to enhance your VBA projects. The SHFileOperation API function lets you build a flexible backup utility that creates safety copies of your documents while you work.
In Part II I'll discuss a novel way to create backup copies of your documents and sessions in compressed archives, better known as ZIP files. We'll also add some new features to the Backup class, such as a function that auto-detects removable drives, and one that beats the VBA MkDir statement by creating complete folder paths in a single command. Watch this space for more VBA hacks!
Romke Soldaat wrote a number of popular Office add-ons, such as Office Toys and Visual Fonts. After a career as an advertising copywriter, he was hired by Microsoft in 1988 to co-found the Microsoft International Product Group in Dublin, Ireland. That same year, he started working with the prototypes of WinWord, writing his first macros long before the rest of the world. In 1992, he left Microsoft and retired to France, where he now does what he likes most: writing software that makes Microsoft products better and easier to use. Romke's Web site (from where you can download a number of shareware and freeware Office 97 add-ons) is www.officetoys.com, and he can be contacted via e-mail at romke@officetoys.com.
Begin Listing One - Backup class: Part I
Option Explicit
DefStr S
DefBool B
DefInt I
DefLng L
Dim objFSO As Object
Private Declare
Function SHFileOperation _
Lib
"shell32.dll" Alias "SHFileOperationA"
_
(lpFileOp As SHFILEOPSTRUCT) As
Long
Private Type
SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private Const
FO_COPY = &b
Private Const
FOF_NOCONFIRMATION = &H10
Private Const
FOF_NOCONFIRMMKDIR = &b00
Private Const
FOF_MULTIDESTFILES = &H1
Private strDestination
Private bShowStatus
Private lngBackupWhat
Private lngSaveFirst
Public Enum
bkSave
bkAlways
bkOnlyIfSavedBefore
bkNever
End Enum
Public Enum
bkCopy
bkCurrentFile
bkEntireSession
End Enum
Property Get
BackupWhere() As String
BackupWhere =
strDestination
End Property
Property Let
BackupWhere(strDest)
' Add colon if single drive letter specified.
If Len(strDest) = 1 Then strDest
= UCase(strDest) & ":"
strDestination = strDest
End Property
Property Get
BackupWhat() As bkCopy
BackupWhat =
lngBackupWhat
End Property
Property Let
BackupWhat(lngWhat)
If Abs(lngWhat) > 1 Then
lngWhat = 0
lngBackupWhat = lngWhat
End Property
Property Get
SaveFirst() As bkSave
SaveFirst = lngSaveFirst
End Property
Property Let
SaveFirst(lngSave As bkSave)
If Abs(lngSave) > 2 Then
lngSave = 0
lngSaveFirst = lngSave
End Property
Property Get
ShowStatus() As Boolean
ShowStatus = bShowStatus
End Property
Property Let
ShowStatus(bShow)
bShowStatus = bShow
End Property
Public Function
Execute()
On Error Resume
Next
Dim strQuote, strSep
Dim strFullPath, strDriveName
Dim strSource, strDest
Dim strProgress
Dim iCutOff
Dim bSuccess, bRecreatePath
Dim AWin As Window
Dim ThisFile As Object
strQuote = Chr(34)
strSep = vbNullChar
' Bail out if there's nothing to back up.
If Windows.Count = 0 Then
ReportBackupError 1
Exit Function
End If
' Bail out if no destination was specified.
If BackupWhere = vbNullString Then
ReportBackupError 2
Exit Function
End If
' See if the Backup drive is valid.
strDriveName =
objFSO.GetDriveName(BackupWhere)
' Test if the drive exists.
If Not
objFSO.DriveExists(strDriveName) Then
ReportBackupError 3,
strDriveName
Exit Function
End If
' Test if the drive is available.
If Not
objFSO.GetDrive(strDriveName).IsReady Then
ReportBackupError 4,
strDriveName
Exit Function
End If
' Test if the drive is a CD-ROM drive.
If objFSO.GetDrive(strDriveName).DriveType = 4 Then
ReportBackupError 5,
strDriveName
Exit Function
End If
' At this point we know that the destination is on a
' valid drive or network share.
If bSameString(strDriveName, BackupWhere) Then
' BackupWhere is a drive (not a folder), so we assume
' files must be backed up with their full path
' recreated on the backup drive.
bRecreatePath = True
End If
Select Case BackupWhat
Case bkEntireSession ' Backup all active documents.
For Each AWin In Windows
' Get the document name associated with the window.
Set ThisFile = AWin.Parent
If ((SaveFirst = bkOnlyIfSavedBefore And _
ThisFile.Path <> vbNullString)
Or _
SaveFirst =
bkAlways) Then
' Allow for user cancelling the SaveAs dialog.
On Error Resume Next
ThisFile.Save
On Error GoTo 0
' Let the operating system do its work.
DoEvents
End If
' If saved, add to source and BackupWhere strings.
If ThisFile.Path <> vbNullString Then
strFullPath =
ThisFile.FullName
' See if it is already in the list.
If InStr(strSource, strFullPath) = 0 Then
' If not, add it.
strSource =
strSource & strFullPath & strSep
If bRecreatePath = True
Then
' Replace source file's drivename.
iCutOff = _
Len(objFSO.GetDriveName(strFullPath)) + 1
strFullPath
= objFSO.BuildPath(BackupWhere, _
Mid(strFullPath, iCutOff))
strDest =
strDest & strFullPath & strSep
End If
End If
End If
Next
If strDest = vbNullString Then
strDest = BackupWhere
strProgress = _
"Backing up
current session to " & BackupWhere
Case Else ' Only back up
active document.
Set ThisFile = ActiveWindow.Parent
' Save if specified.
If ((SaveFirst = bkOnlyIfSavedBefore And _
ThisFile.Path
<> vbNullString) Or _
SaveFirst =
bkAlways) Then
' Allow for user cancelling the SaveAs dialog box.
On Error Resume Next
ThisFile.Save
On Error GoTo 0
' Let the operating system do its work.
DoEvents
' Still no path? Exit!
If ThisFile.Path = vbNullString Then Exit Function
End If
strSource =
ThisFile.FullName
If bRecreatePath = True
Then
' Remove drivename from source file.
iCutOff =
Len(objFSO.GetDriveName(strSource)) + 1
strDest =
objFSO.BuildPath( _
BackupWhere, Mid(strSource, iCutOff))
Else
strDest = _
objFSO.BuildPath(BackupWhere,
ThisFile.Name)
End If
If bSameString(strSource, strDest) Then
ReportBackupError
6, strSource
Exit Function
End If
strProgress =
"Backing up " & strQuote & _
ThisFile.Name & strQuote & " to " & _
strQuote & strDest & strQuote
End Select
Dim fo As SHFILEOPSTRUCT
With fo
.wFunc = FO_COPY
.pFrom = strSource
.pTo = strDest
.fFlags =
FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION + _
IIf(bRecreatePath, FOF_MULTIDESTFILES, 0)
End With
If ShowStatus = True Then
Application.StatusBar =
strProgress
End If
Execute =
(SHFileOperation(fo) = 0)
' Let the operating system do its work.
DoEvents
If ShowStatus = True Then
Application.StatusBar = strProgress &
IIf( _
Execute, " >>> OK", " >>> ERROR!")
End If
End Function
Private Sub
ReportBackupError( _
iErr, Optional ByVal
strParam$)
Dim strMsg
Select Case iErr
Case 1:
strMsg =
"Nothing to back up!"
Case 2:
strMsg = "No
backup destination specified"
Case 3:
strMsg = "Drive
" & strParam & " does not exist!"
Case 4:
strMsg = "Drive
" & strParam & " is not ready!"
Case 5:
strMsg = "Drive
" & strParam & " is a CD-ROM Drive!"
Case 6:
strMsg =
"Source and destination are the same:" & _
vbCr &
strParam
Case 7:
strMsg =
"VBScript not installed!"
Case Else:
End Select
If strMsg <> vbNullString Then
MsgBox strMsg,
vbCritical, "Backup failed!"
End If
End Sub
Private Function
bSameString(ByVal String1, ByVal String2)
' Wrapper function to compare two strings without
' looking at case.
bSameString = _
(StrComp(String1, String2, vbTextCompare) = 0)
End Function
Private Sub
Class_Initialize()
' Runs first time a new instance of the class is created.
On Error Resume
Next
' Create and return a reference to the VBScript
' FileSystemObject object.
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Err Then ReportBackupError 7
End Sub
Private Sub
Class_Terminate()
' Runs when the last pointer to the class instance is
' released. Release memory associated with the object.
Set objFSO = Nothing
End Sub
End Listing One
Copyright© 1999 Informant Communications Group. All Rights Reserved. • Send feedback to the Webmaster • Important information about privacy