Ten Tips for Office VBA Developers (February 2003)
Paul Cornell and Frank C. Rice
Microsoft® Office XP
Summary: Learn tips and use sample code for several Office applications. These tips can help you to be more productive and can also be a starting point for developing your own tools, utilities and techniques. (18 printed pages)
Update Word Document Statistics in the Title Bar
Create Outlook Rules Programmatically
Delete Repeated Text Throughout a Word Document
Run Macros Based on the Value of One or More Excel Spreadsheet Cells
Disable Related Controls on a PowerPoint Slide After a User Clicks an Input Control
Display Reminder Information When a User Opens an Office Document
Synchronize an Access Main Form to a Subform and Vice Versa
Log Worksheet Changes to an XML File
Merge Body Text from Multiple Outlook E-mail Messages to a Word Document
Use the Office Assistant as an Alternative to Displaying and Retrieving User Input
You can keep a running total of document statistics in the Microsoft® Word title bar. This is quicker than clicking Word Count on the Tools menu, and the results are more visible.
To display document statistics in the title bar:
- Create a new class module in the active document's ThisDocument project and name it clsWordApp.
- Insert the following code into the
Public WithEvents appWord As Word.Application Private Sub appWord_WindowSelectionChange(ByVal Sel As Selection) Application.ActiveWindow.Caption = _ "Words: " & Application.ActiveDocument.Words.Count & _ " / Characters: " & Application.ActiveDocument.Characters.Count End Sub
- Insert the following code into the active document's ThisDocument project:
Dim woApp As New clsWordApp Private Sub Document_Open() Set woApp.appWord = Word.Application End Sub
- Close the document and reopen it.
- Change the active selection. Using this code example, the document's word and character counts will update in the title bar.
Figure 1. Word document with word and character count in title bar
The Application_NewMail event is fired automatically whenever new e-mail messages arrive in your Microsoft Outlook® Inbox. To create automatic actions for new e-mail messages, you can use the Rules Wizard (Tools menu). If you want Outlook to perform an action that is too complex for the Rules Wizard, create the action using code based on the Outlook object model and place the code in the Application_NewMail event of the VbaProject.OTM project's ThisOutlookSession module.
As a simple example, the following code places any e-mail message with the letters "XXX" in the subject line into the Deleted Items folder:
' Purpose: Sends any e-mail with the text "XXX" ' in the subject line directly to the Deleted Items folder. Dim olApp As Outlook.Application Dim olNS As Outlook.NameSpace Dim olFld As Outlook.MAPIFolder Dim oMail As Outlook.MailItem Set olApp = Outlook.Application Set olNS = olApp.GetNamespace("MAPI") Set olFld = olNS.GetDefaultFolder(olFolderInbox) olFld.Items.Sort "Received", False Set oMail = olFld.Items.GetFirst If InStr(1, LCase(oMail.Subject), "xxx") > 0 Then oMail.Delete End If Set oMail = Nothing Set oFld = Nothing Set oNS = Nothing Set olApp = Nothing
To add this code to your Outlook project:
- Start Outlook.
- On the Tools menu, click Macro, and then click Visual Basic Editor.
- In the Project Explorer, double-click ThisOutlookSession.
- Click in the code window, click Application in the Object drop-down list, and then click NewMail in the Procedure drop-down list.
- In the
Application_NewMailevent procedure, copy and paste the above code.
- Close the Visual Basic Editor.
- To test the procedure, you can send yourself a message with XXX in the subject line or have someone else send you the message. Once the message is received, you can check the Deleted Items folder to ensure that the message was deleted.
Sometimes, it would be nice to be able to delete text that appears throughout a document. For example, when a product goes from beta testing to product release, you'd probably want to remove all "beta" references in sales documents. In addition, wouldn't it be even better if you could do this with the click of a button? The following procedures allow you to do both of these in Word. The first routine creates a toolbar and button that you click to call the second procedure. The second procedure deletes repeated text throughout a Word document without using the Find and Replace dialog box. This is useful for deleting text in multiple documents without reconfiguring the Find and Replace dialog box for each document.
Private Sub Document_Open() ' Purpose: Creates the delete text toolbar. Dim objCommandBar As Office.CommandBar Dim objCommandBarButton As Office.CommandBarButton For Each objCommandBar In Application.CommandBars If objCommandBar.Name = "Remove Repeating Text" Then objCommandBar.Delete End If Next objCommandBar Set objCommandBar = Application.CommandBars.Add _ ("Remove Repeating Text") ' To delete this toolbar, call: ' Application.CommandBars("Remove Repeating Text").Delete ' Add the command button control to the toolbar. With objCommandBar.Controls Set objCommandBarButton = .Add(msoControlButton) With objCommandBarButton .Caption = "&Zap Repeating Text" .FaceId = 59 .Style = msoButtonIconAndCaption .TooltipText = _ "Removes repeating text you specify." .OnAction = "RemoveText" End With End With objCommandBar.Visible = True End Sub Private Sub RemoveText() ' Purpose: Deletes repeated text in a Word document. Dim strTextToFind As String strTextToFind = Trim(InputBox("Please enter the repeating text " & _ "you wish to remove. Only standalone text will be removed.")) Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = strTextToFind .Replacement.Text = "" .Wrap = wdFindContinue .Format = False .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll MsgBox "All occurrence of the text " & _ strTextToFind & " have been deleted." End Sub
The following macro runs others macros based on the value of one or more Microsoft Excel spreadsheet cells. If the cell's value evaluates to True, a specified macro runs; if the cell's value evaluates to False, another macro runs. To test it out, insert the following code into an Excel workbook's ThisWorkbook project, select one or more cells, and then run the
RunConditionalMacros subroutine by pointing to Macro on the Tools menu and then clicking Macros. In the Macro dialog box, click ThisWorkbook.RunConditionalMacros, and then click Run.
Public Sub RunConditionalMacros() ' Purpose: Demonstrates running conditional macros. ' Note: Select a range of cells before running this macro. Dim oCells As Excel.Range Dim oCell As Excel.Range ' Insert your own value here or use the ' InputBox function to prompt the user. Const TARGET_VALUE As String = "10" Set oCells = Application.Selection For Each oCell In oCells MsgBox IIf(oCell.Value = TARGET_VALUE, _ DisplayTrue, DisplayFalse) Next oCell End Sub\ Private Function DisplayTrue() As String ' Take some action if the condition is true. DisplayTrue = "True condition reached." End Function Private Function DisplayFalse() As String ' Take some action if the condition is false. DisplayFalse = "False condition reached." End Function
Microsoft PowerPoint® is a great tool for creating online surveys, questionnaires and quizzes. Here's one approach to creating an interactive quiz.
- Create a new, blank PowerPoint presentation.
- On the View menu, point to Toolbars, and click Control Toolbox.
- Add the following controls with the following properties to the first slide:
Control Property Value Label (Name) lblQuestion Caption How many miles is the Earth from the Sun? OptionButton (Name) optA Caption 10 million OptionButton (Name) optB Caption 93 million OptionButton (Name) optC Caption 1 billion TextBox (Name) txtAnswer CommandButton (Name) btnAgain Caption Try Again
- Insert the following VBA code into the form:
Private Const CORRECT_ANSWER As String = "Correct! Great job!" Private Const INCORRECT_ANSWER As String = "Incorrect. Try again." Private Sub btnAgain_Click() optA.Value = False optB.Value = False optC.Value = False optA.Enabled = True optB.Enabled = True optC.Enabled = True txtAnswer.Text = "" End Sub Private Sub optA_Click() optB.Enabled = False optC.Enabled = False txtAnswer.Text = INCORRECT_ANSWER End Sub Private Sub optB_Click() optA.Enabled = False optC.Enabled = False txtAnswer.Text = CORRECT_ANSWER End Sub Private Sub optC_Click() optA.Enabled = False optB.Enabled = False txtAnswer.Text = INCORRECT_ANSWER End Sub
- Close the Visual Basic Editor to return the presentation.
- Click Slide Show on the View menu.
- Click an incorrect answer (10 million or 1 billion), and then click Try Again.
- Click the correct answer (93 million).
Figure 2. Sample quiz in PowerPoint
It's often helpful to display reminder information to users, usually in the form of a message box, when Office documents are opened. To do so:
- In Word, place the reminder code in the document's Document_Open event.
Private Sub Document_Open() ' Insert your own reminder text here. Msgbox "Don't forget to save early and save often!" End Sub
- In Excel, place the reminder code in the workbook's Workbook_Open event.
- In PowerPoint, place the reminder code in the application's Application_PresentationOpen event.
- In Outlook, place the reminder code in the ThisOutlookSession module's Application_Startup event.
- In Microsoft Access, create a reminder form; click Startup on the Tools menu, and then click the reminder form in the Display Form/Page list.
With just a few lines of VBA code, you can synchronize an Access main form and a subform so that each time you scroll to a record in one form, the other form automatically moves to the corresponding record. Using the code in the following procedure keeps the forms synchronized regardless of whether you are scrolling on the main form or scrolling on the subform. The following steps will walk you through creating a simple main form and subform, and then adding code to the On Current events of both form to keep them synchronized:
- Start Access and create a blank database.
- Create a new table and add the following fields/records:
EmployeeID FirstName LastName Phone 1 Nancy Davolio (206) 555-9857 2 Andrew Fuller (206) 555-9482 3 Janet Leverling (206) 555-3412 4 Margaret Peacock (206) 555-8122
- Close and save the table as Employees.
- To create the main form, in the Database window, click Forms under Objects.
- Click the New button on the Database window toolbar.
- In the New Form dialog box, click the Employees table as the data source for the form.
- Then, click the AutoForm: Tabular wizard, and then click OK.
- Click Design View on the View menu.
- Click Properties on the View menu.
- Click the Event tab, click the On Current event, click the ellipses (. . .), and in the Choose Builder dialog box, click Code Builder, and then click OK.
- Insert the following into the event procedure:
Employees.Form.RecordsetClone.FindFirst "EmployeeID = " & Me.EmployeeID Employees.Form.Bookmark = Employees.Form.RecordsetClone.Bookmark
- Close the form and save it as Mainfrm.
- To create the subform, click the New button on the Database window toolbar.
- In the New Form dialog box, click the Employees as the data source for the form.
- Then, click the AutoForm: Datasheet wizard, and then click OK.
- Click Design View on the View menu.
- Click Properties on the View menu.
- On the All tab, make sure that Default View is set to Datasheet.
- Click the Event tab, click the On Current event, click the ellipses (...), and in the Choose Builder dialog box, click Code Builder, and then click OK.
- Insert the following into the event procedure:
If Me.EmployeeID <> Me.Parent.EmployeeID Then ' The forms aren't synchronized. Me.Parent.RecordsetClone.FindFirst "EmployeeID = " & Me.EmployeeID Me.Parent.Bookmark = Me.Parent.RecordsetClone.Bookmark End If
- Close the form and save it as Subfrm.
- Open the Mainfrm form in Design view.
- Drag the Subfrm form from the Database window to the Mainfrm form.
- With the Subfrm subform highlighted on the main form, click Properties on the View menu.
- In the Subform/Subreport:Employees property sheet, clear the Link Child Fields and Link Master Fields boxes.
- Close the Property sheet. Resize the subform as needed to fit the main form.
- Open the Mainfrm in Form view. Using the navigation buttons on first the main form and then the subform, scroll through the records. Notice that moving to a record on the main form automatically moves to the same record on the subform and vice versa.
Figure 3. Synchronized Access main form and subform
Many times, it's important to record the changes made to a worksheet in order to be able to compare one day's activities to another day's activities, for example. The procedures in this section provide a way to do that by providing code that copies the cell address and date/time to another "log" spreadsheet and then saving the log to an Extensible Markup Language (XML) file. The XML file allows the file data to be read by any number of applications:
- To begin, start Excel and open a workbook with the worksheet containing the data whose activities you want to log.
- Add the log worksheet to the workbook by clicking Worksheet on the Insert menu.
- Right-click the inserted worksheet's tab and rename the sheet to Log.
- Right-click the tab of the worksheet containing the data, click View Code.
- In the Object drop-down list box (left-hand side), click Worksheet.
- In the Procedure drop-down list box, click Change.
- In the On Change event procedure, replace the generated code with the following, and then close the Visual Basic Editor:
Public intRowNum As Integer Private Sub Worksheet_Change(ByVal Target As Range) Dim wks1 As Worksheet Dim wks2 As Worksheet Set wks1 = ActiveWorkbook.Worksheets("Datasht") Set wks2 = ActiveWorkbook.Worksheets("Log") ' Initialize the global row incrementer. If intRowNum <= 0 Or intRowNum = Null Then intRowNum = 1 Else intRowNum = intRowNum + 1 End If ' Check if a specific cell is changed. If Target.Address = "$C$3" Then MsgBox Target.Address & " has changed" End If ' Regardless, log the change to Log. wks2.Cells(intRowNum, 1).Value = Target.Address wks2.Cells(intRowNum, 2).Value = Now End Sub
This procedure will log the cell address and date/time to the Log worksheet whenever a cell is changed. It also contains code to display a message box whenever the contents of a specific cell change. This could also be modified to send an alert through email, to an XML Web service or some other method of notification. The following code is fired just before the workbook closes to save the Log worksheet to an XML file:
- Once again, right-click the tab of any of the worksheet's in the workbook and click View Code.
- In the Project Explorer, double-click ThisWorkbook.
- In the Object drop-down list box, click Worksheet.
- In the Procedure drop-down list box, click BeforeClose.
- In the BeforeClose event procedure, replace the generated code with the following, and then close the Visual Basic Editor:
Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim wks As Worksheet Set wks = ActiveWorkbook.Worksheets("Log") wks.SaveAs Filename:="C:\TheDailyLog.xml", FileFormat:=xlXMLSpreadsheet End Sub
Now each time you close the workbook the Log worksheet is saved to an XML file.
There may be occasions where you need to merge multiple Outlook item body texts into a single Word document, for example, to combine the text of related messages into a report. In addition, it's almost always easier to perform a task from a toolbar button. The following steps can be used to paste the code into Outlook and create a toolbar button without using VBA.
- Start Outlook.
- On the Tools menu, point to Macro, and then click Visual Basic Editor.
- In the Visual Basic Editor, click Module on the Insert menu.
- In the Project Explorer, double-click the module that was inserted.
- Insert the following subroutine into the code window:
Public Sub MergeEMailsToWordDocument() ' Purpose: Concatenates selected Microsoft Outlook item body texts ' into a single Microsoft Word document. ' Note: You must have at least one item selected. ' Special References: ' Microsoft Word 10.0 Object Library (MSWORD.OLB). Dim olApp As Outlook.Application Dim oSel As Outlook.Selection Dim oObj As Object Dim sText As String Dim wdApp As Word.Application Dim oDoc As Word.Document Set olApp = Outlook.Application Set oSel = olApp.ActiveExplorer.Selection For Each oObj In oSel sText = sText & oObj.Body & vbCrLf & vbCrLf Next oObj Set wdApp = New Word.Application wdApp.Visible = True Set oDoc = wdApp.Documents.Add oDoc.Range = sText Set oDoc = Nothing Set wdApp = Nothing Set oObj = Nothing Set oSel = Nothing Set olApp = Nothing End Sub
- Close the Visual Basic Editor.
- To create a button on the Standard toolbar to run the procedure, point to Toolbars, on the View menu, and then click Customize.
- On the Commands tab in the Categories list, click Macros. The macro will be listed as Project1.MergeEMailsToWordDocument.
- Drag the macro name to a toolbar.
- With the toolbar button selected, click Modify Selection, and change the name of the button to Merge To Word.
- Make any additional desired changes to the appearance of the button, and then click Close.
- To test, click one or more messages (press and hold the CTRL key while clicking to select multiple messages) in the Outlook Explorer, and then click Merge To Word. Word starts up with the body text from the messages you selected concatenated in the document.
The Office Assistant (also known as "Clippy") can serve as a great alternative to displaying and retrieving user input. Before running the following procedures, the Office Assistant must be enabled although it can be hidden. If the Office Assistant isn’t displayed when you run the procedures, click Show the Office Assistant on the Help menu (if the option displayed on the Help menu is Hide the Office Assistant, the Office Assistant is already enabled). To work with the Office Assistant in your application, use code similar to the following:
Private Sub AssistantMsgBox() ' Purpose: Demonstrates using the Office Assistant ' as an alternative to the VBA MsgBox function. ' Special References: ' Microsoft Office 10.0 Object Library (MSO.DLL). Dim oApp As Application Dim oAst As Office.Assistant Dim oBal As Office.Balloon ' Substitute for your particular text. Const MSG_TEXT As String = "Click Me!" Set oApp = Application Set oAst = oApp.Assistant Set oBal = oAst.NewBalloon oAst.Visible = True oBal.Text = MSG_TEXT oBal.Show Set oBal = Nothing Set oAst = Nothing Set oApp = Nothing End Sub
To allow the Assistant to get user input, you can use code similar to the following:
Private Sub AssistantInputBox() ' Purpose: Demonstrates using the Office Assistant ' to get user input. ' Special References: ' Microsoft Office 10.0 Object Library (MSO.DLL). Dim oApp As Application Dim oAst As Office.Assistant Dim oBal As Office.Balloon Dim oLbls As Office.BalloonLabels Dim iResp As Integer Dim sResp As String ' Substitute for your particular text. Const MSG_TEXT As String = "What's your favorite school subject?" Const TEXT_1 As String = "Math" Const TEXT_2 As String = "History" Const TEXT_3 As String = "Neither" Set oApp = Application Set oAst = oApp.Assistant Set oBal = oAst.NewBalloon Set oLbls = oBal.Labels oLbls.Item(1).Text = TEXT_1 oLbls.Item(2).Text = TEXT_2 oLbls.Item(3).Text = TEXT_3 oAst.Visible = True oBal.Text = MSG_TEXT Do iResp = oBal.Show Loop While iResp = -1 sResp = oBal.Labels(iResp).Text Set oBal = Nothing Set oBal = oAst.NewBalloon oBal.Text = "You clicked '" & sResp & "'." oBal.Show Set oBal = Nothing Set oAst = Nothing Set oApp = Nothing End Sub