Code For Excel And Outlook Blog

Updated VBA Backup code

JP — Mon, 09 Nov 2009 11:30:24 +0000

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).

' API to make a copy of a currently open file
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.

Download sample workbook

Updated VBA Backup code is Copyright © Code For Excel And Outlook.
Click here for plug-and-play Excel Dashboards

Use textboxes like date or phone number fields

JP — Thu, 05 Nov 2009 11:30:29 +0000

Textboxes on Excel userforms work a little different than their Access equivalents. For one thing, you can't specify an input format. A textbox is just, well, a textbox.

But with VBA, we can make our textboxes act like date or phone number fields. Just like Access!

Simply put, you need to write code for the Enter, Exit and AfterUpdate events to simulate what would happen if a given field holds a Date or Phone Number.

The first thing you want to do is place the following at the top of your form's module:

Const DEFAULT_PHONE_FIELD As String = "( ) ___ - ____"
Const DEFAULT_DATE_FIELD As String = "__/__/____"

These are the constants that will be used to format the empty textboxes that we'll use for the date and phone fields. Here are the event handlers that make up the phone field:

Private Sub HomePhoneNumber_Enter()

On Error GoTo ErrorHandler

With Me.HomePhoneNumber
If .Value = DEFAULT_PHONE_FIELD Then
.Value = ""
End If
End With

ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub

Private Sub HomePhoneNumber_Exit(ByVal Cancel As MSForms.ReturnBoolean)

On Error GoTo ErrorHandler

With Me.HomePhoneNumber
If Len(.Value) = 0 Then
.Value = DEFAULT_PHONE_FIELD
End If
End With

ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub

Private Sub HomePhoneNumber_AfterUpdate()

On Error GoTo ErrorHandler

' format phone number
With Me.HomePhoneNumber
If Len(.Value) = 10 Then
.Value = Format(.Value, "(###) ###-####")
Else
.SetFocus
.SelStart = 0
.SelLength = Len(.Value)
End If
End With

ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub

The event handlers for the date field are similar. The Initialize event for the Userform sets up the fields when the form loads:

Private Sub UserForm_Initialize()
With Me
.HomePhoneNumber.Value = DEFAULT_PHONE_FIELD
.TodaysDate.Value = DEFAULT_DATE_FIELD
End With
End Sub

The sequence is like this: when the form loads, the fields are made to look like date or phone fields. When a field is entered, if it only contains the pseudo field information, clear it out to prepare for data entry. If the field is left (i.e. the user tabs to the next field), put the default information back in. If something is typed into the field, but it's not a phone number, highlight the field (I'm a big believer in not interrupting the user, but giving them a visual clue that they didn't enter the information correctly).

I created a userform so you can see these fields in action. The download link is below.

Date and phone fields sample workbook (visit the site to download)

Use textboxes like date or phone number fields is Copyright © Code For Excel And Outlook.
Click here for plug-and-play Excel Dashboards

Free Book Giveaway

JP — Tue, 03 Nov 2009 11:30:33 +0000

(Update 11/3/2009 8:00PM EST: All of the books have been distributed, thanks to everyone who emailed. I'll give away more in the future. –JP)

If anyone wants, I'm giving away the following books. They're gently used and overall in good condition. Just drop me a line and I'll tell you which ones are still available. First come, first serve. One book per person/address. I will mail them out this coming Saturday, so please contact me by Friday at the latest. After that they are going to the library or the trash. Sorry, U.S. residents only (otherwise the shipping is more than the cost of the book).

Free Book Giveaway is Copyright © Code For Excel And Outlook.
Click here for plug-and-play Excel Dashboards

Is that an Excel file I see?

JP — Mon, 02 Nov 2009 12:00:01 +0000

The GetFilesList function loops through a given folder, compares the file extension of each file against the given file extension, and returns a list of matching filenames.

Here's an intermediate function which can be called within the Do loop to check if the current filename has an appropriate Excel extension (i.e. instead of doing the comparison directly inside the GetFilesList function):

Function IsExcelFileType(fileName As String)
' returns True is file extension starts with 'xl', i.e. xla, xlam, xlsx, etc
IsExcelFileType = (UCase$(Left$(GetFileType(fileName), 2)) = "XL")
End Function

Function GetFileType(fileName As String) As String
' get file extension
GetFileType = Mid$(fileName, InStrRev(fileName, ".") + 1, Len(fileName))
End Function

The function is hard-coded for Excel files, but my assumption is that this is what most people are looping for anyway. So, assuming that you are looking for all Excel files in a folder, here is the updated GetFilesList function:

Function GetFilesList(ByVal folder As String, ByVal fileType As String) As String()
' build list of files in a folder folder
Dim fileslist() As String
Dim i As Long
Dim currentWorkbook As String

currentWorkbook = Dir(folder)

Do While Len(currentWorkbook) > 0
If IsExcelFileType(currentWorkbook) Then
ReDim Preserve fileslist(i)
fileslist(i) = currentWorkbook
i = i + 1
End If

currentWorkbook = Dir
Loop
GetFilesList = fileslist

End Function

On Being a Responsible Outlook user

JP — Thu, 29 Oct 2009 11:00:51 +0000

The Microsoft Exchange Team Blog has a two part series on how to disable the Reply To All functionality using MS Exchange. Yikes.

To me, it seems like an organizational disease or culture problem when you have to resort to blocking the feature at the Exchange level.

This function can be disabled at the single user message level with a bit of VBA:

ActiveInspector.CurrentItem.Actions("Reply to All").Enabled = False

(from Redirect Messages)

You can disable the Reply function as well, for "announce only" messages:

ActiveInspector.CurrentItem.Actions("Reply").Enabled = False

And you can even stop messages from being forwarded:

ActiveInspector.CurrentItem.Actions("Forward").Enabled = False

Here's what happens when you try the menu option, press the hotkey combination, or click the toolbar button for any of these three choices:

For ease of use, this code should be assigned to a toolbar, either in Outlook or on an individual message. As far as I can tell, you can not disable these options without programming code.

So save your co-workers from the e-mail storm: if your message does not need a reply, or you want to avoid the Reply To All issue, use these codes to manage your email.

On Being a Responsible Outlook user is Copyright © Code For Excel And Outlook.
Click here for plug-and-play Excel Dashboards