505.369.1650 [email protected]

This VBA function opens/gets a MS Word document and finds the next occurrence of a specific string. The function provides a good example of using late binding automation and the AppActivate statement.

One advantage of late binding (using generic objects, like objWd in the function) is that you are not forced to reference a particular Word library, which may be helpful if you do not know which version of Word the user has installed. The downside is that you must define any Word constant that you use, which is why wdFindContinue was defined.

AppActivate() makes it easy to activate a particular application that is open on the screen by referencing the caption found in the window title. In the function, in the case where the text was not found, the Word document was still active, so it was necessary to activate the application running the code first before showing the message box. Otherwise, the user would hear the ding when the message box popped up, but the Word document would cover it and the user would not see it.

If you use a MS Word document as a user manual for your Microsoft Access application, you can use this VBA function in the Click event of a button to open the document and position the user at a particular title or piece of text in the document. If they were to click the button again once the document is open, the next occurrence of the text would be found. It is a simple way to provide context-sensitive help.

Code:

Function OpenWordAndFind(WordFileName As String, Optional WordFindText) As Boolean
' If the Microsoft Word file specified in WordFileName is not open yet, it will
' be opened.  If a value for WordFindText is specified, it will find the next
' occurrence of the value.

' OpenWordAndFind() Version 1.0.0
' Copyright © 2009 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact [email protected].
' Use (at your own risk) and modify freely as long as proper credit is given.
On Error GoTo Err_OpenWordAndFind

    Dim strPrompt As String
    Dim objWd As Object
    Dim strAppName As String
    Dim intPos As Integer
    Const wdFindContinue As Integer = 1

    ' Get the name of the Word document from the path in WordFileName
    ' by finding the last  and grabbing all the characters to the right
    ' of that position.
    intPos = InStrRev(WordFileName, "")
    strAppName = Right(WordFileName, Len(WordFileName) - intPos)

    ' If the Word document is already open, get the document.  If it is
    ' not already open, then GetObject will open it.
    Set objWd = GetObject(WordFileName)

    ' Make the Word application visible.  It must be visible to do the find.
    objWd.Application.Visible = True

    ' If there is text to find, find it.
    If Not IsMissing(WordFindText) Then
        With objWd.Application.Selection.Find
            .Text = WordFindText
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute

            ' If the value cannot be found, then message the user, show
            ' the document, and pass back a False.
            If Not .Found Then
                ' So that the user will see the message, activate this
                ' application first.
                AppActivate Application.Name
                ' Show the message.
                strPrompt = "The search term '" & WordFindText & "' cannot be found."
                MsgBox strPrompt, vbInformation + vbOKOnly, "Cannot Find"
                ' Activate the Word window so that it is on top.
                AppActivate strAppName
                ' Pass back a False.
                OpenWordAndFind = False
                GoTo Exit_OpenWordAndFind
            End If
        End With
    End If

    ' Activate the Word window so that it is on top.
    AppActivate strAppName

    ' Pass back a True.
    OpenWordAndFind = True

Exit_OpenWordAndFind:
    On Error Resume Next
    ' Release the Word object.
    Set objWd = Nothing
    Exit Function

Err_OpenWordAndFind:
    Select Case Err.Number
    Case 432
        ' Can't find the file.
        strPrompt = "The Word document cannot be found:" _
        & vbCrLf & vbCrLf & WordFileName
        MsgBox strPrompt, vbInformation, "Cannot Find"
    Case Else
        MsgBox Err.Number & " " & Err.Description, , "OpenWordAndFind"
    End Select

    ' Pass back a False.
    OpenWordAndFind = False
    Resume Exit_OpenWordAndFind
End Function

Download Code:

basOpenWordAndFind.zip