Mail Merge - Office 2003

[jtkinsella]

Hello All - I thought that I had already posted this call earlier but I
cannot seem to find it. If I am double posting please accept my
apologies.
I am attempting to create a mail merge from Outlook to a Word document.
I can do it via the menu but am looking for a one-click method where
all the information remains static. I found this post here
http://groups.google.ca/group/micro...36c846f?q=mail+merge&rnum=22#036e13b1236c846f
and changed it to suit my situation but it I am not able to get it to
function.
I have included my code below. It dies on this line:
Private Function fillbookmark(sBookmark As String, sValue As String, _
odoc As word.document) As Boolean
I have entered the code in a new module from within outlook.
I am very new to this kind of stuff so any assistance that you can
provide would be much appreciated.

Thanks Terry

Public Sub WordBookmark()
Dim oOutlook As Outlook.Application
Dim oInspector As Outlook.Inspector
Dim oItem As Object
Dim oContact As Outlook.ContactItem
Dim oWord As word.Application
Dim odoc As word.document
Dim sBkmName As String
Dim sTemplateName As String
Dim blnFill As Boolean
Dim fillbookmark As Boolean
'Change this file name and location if necessary.
sTemplateName = "C:\My Documents\Fax Template (blue)1.dot"

'Get an Outlook Application object
On Error Resume Next
Set oOutlook = GetObject(, "Outlook.Application")
If oOutlook Is Nothing Then
Set oOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo WordBookmarkError


Set oInspector = oOutlook.ActiveInspector


'Look for an open Inspector window.
If oInspector Is Nothing Then
MsgBox "There is no open item"
Else
Set oItem = oInspector.CurrentItem
'Make sure the open item is a ContactItem.
If oItem.Class = olContact Then
Set oContact = oItem
'Get a Word Application object
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
If oWord Is Nothing Then
Set oWord = CreateObject("Word.Application")
End If
On Error GoTo WordBookmarkError
'Add a document based on our template.
Set odoc = oWord.Documents.Add(sTemplateName)
With oContact
'Fill each bookmark in turn.
sBkmName = "FullName"
blnFill = fillbookmark(sBkmName, .FullName, odoc)

sBkmName = "fax"
blnFill = fillbookmark(sBkmName, .business_fax, odoc)


'Repeat the function call for each bookmark.
'sBkmName = "StreetAddress"
'blnFill = FillBookmark(sBkmName, .BusinessAddressStreet, _
oDoc)
'sBkmName = "City"
'blnFill = FillBookmark(sBkmName, .BusinessAddressCity, _
oDoc)


'sBkmName = "State"
'blnFill = FillBookmark(sBkmName, .BusinessAddressState, _
oDoc)


'sBkmName = "PostalCode"
'blnFill = FillBookmark(sBkmName, .BusinessAddressPostalCode, _
oDoc)


'sBkmName = "FirstName"
'blnFill = FillBookmark(sBkmName, .FirstName, _
oDoc)
'End With
'Activate our new document.
odoc.Activate
'Turn off the display of bookmarks.
odoc.ActiveWindow.View.ShowBookmarks = False
'Move the cursor to the end of the document.
oWord.Selection.EndKey Unit:=wdStory, Extend:=wdMove
'Make the document visible.
oWord.Visible = True
odoc.ActiveWindow.Visible = True
Else
MsgBox "This is not a Contact item"
End If
End If


WordBookmarkExit:
'Set all objects to Nothing to prevent memory and
'resource leaks. This still leaves the new docment open.
Set oItem = Nothing
Set oContact = Nothing
Set oInspector = Nothing
Set oOutlook = Nothing
Set odoc = Nothing
Set oWord = Nothing
Exit Sub


WordBookmarkError:
MsgBox "Error occurred: " & Err.Description
GoTo WordBookmarkExit
End Sub

Private Function fillbookmark(sBookmark As String, sValue As String, _
odoc As word.document) As Boolean
With odoc
If .Bookmarks.Exists(sBookmark) Then
.Bookmarks(sBookmark).Range.Text = sValue
fillbookmark = True
Else
fillbookmark = False
End If
End With
End Function