Mail Merge - Office 2003

[jtkinsella]

Hello all,
I am attempting to automate a mail merge from MS Outlook 2003. I have
found some sample code here.

http://groups.google.ca/group/micro...36c846f?q=mail+merge&rnum=22#036e13b1236c846f

But am getting an error when I try to run it. This is my first attempt
in writing in Outlook and am feeling a little flustered so any thing
that you can offer would be appreciated. The error that I am getting is
"Compile error - user defined type not defined" and it is failing on
this line
Private Function fillbookmark(sBookmark As String, sValue As String, _
odoc As word.document) As Boolean
I have only had to slightly modify it for my own uses - at least at
this point - once it is working I am sure I will manipulate it a little
more.

Any help that anyone is willing to offer would be 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

 

[Ken Slovak - [MVP - Outlook]]

Make sure you have a reference set to Word in the VBA project references. In
the Outlook VBA only a reference to Outlook is set automatically.

Tools, References. Set a reference to Word there.

 

[Terry K]

Thank you very much Ken, You were absolutely correct. It now works like
a charm.