VBA with Outlook and Word

[marrett]

Hi

I need Help. I can't seem to get the foolowing doce to work. I got it out of the Outlook 2002 book. I only have 2000. The whole thing works except getting the contact info from the contact folder. Anyone know how to do this in 2000.

I would appreciate any help even a point in the right direction.

Thanks,

Maria

The Code:

Private Sub SendLetterToContact()
Dim itmContact As Outlook.ContactItem
Dim selContacts As Selection
Dim objWord As Word.Application
Dim objLetter As Word.Document
Dim secNewArea As Word.Section

Set selContacts = Application.ActiveExplorer.Selection

If selContacts.Count > 0 Then
Set objWord = New Word.Application

For Each itmContact In selContacts
Set objLetter = objWord.Documents.Add

objLetter.Select

objWord.Selection.InsertAfter itmContact.FullName
objLetter.Paragraphs.Add

If itmContact.CompanyName <> "" Then
objWord.Selection.InsertAfter itmContact.CompanyName
objLetter.Paragraphs.Add
End If

objWord.Selection.InsertAfter itmContact.BusinessAddress
objWord.Selection.Paragraphs.Alignment =wdAlignParagraphRight

With objLetter
.Paragraphs.Add
.Paragraphs.Add
End With

With objWord.Selection
.Collapse wdCollapseEnd
.InsertAfter "Dear " & itmContact.FullName
.Paragraphs.Alignment = wdAlignParagraphLeft
End With

Set secNewArea = objLetter.Sections.Add(Start:=wdSectionContinuous)

With secNewArea.Range
.Paragraphs.Add
.Paragraphs.Add
.InsertAfter "<Insert text of letter here>"
.Paragraphs.Add
.Paragraphs.Add
End With

Set secNewArea = objLetter.Sections.Add(Start:=wdSectionContinuous)

With secNewArea.Range
.Paragraphs.Add
.InsertAfter "Regards"
.Paragraphs.Add
.Paragraphs.Add
.InsertAfter Application.GetNamespace("MAPI").CurrentUser
End With

Next
objWord.Visible = True

End If
End Sub