Check My Code: Contacts Not Going to the Right Folder

[audrie magno]

In the code below, form field data is leaving Word and going to an Outlook contact list. Everything works EXCEPT it puts the new contact in my default contact folder instead of the custom folder... can anyone identify what I did wrong?

Public Sub AddContact()
Dim objOutlook As New Outlook.Application

Dim myNameSpace As NameSpace
Set myNameSpace = objOutlook.GetNamespace("MAPI")
Dim oOlFolder As MAPIFolder
Set oOlFolder = myNameSpace.Folders("Custom Contacts").Folders("Speakers") 'Here is my folder called "Custom Contacts", which is really a pst file on it's own, with a subfolder for contact items called "Speakers"
Dim objContact As ContactItem
Set objContact = objOutlook.CreateItem(olContactItem)

Dim FName As String
Dim HomeTelephone As String
Dim BusinessTelephone As String
Dim MailAddress As String
Dim aField As FormField
Dim myCategory As String
Dim Hour8Training As Integer
Dim Hour65Training As Integer


For Each aField In ActiveDocument.FormFields
If Trim(aField.Result) <> "" Then
If aField.Name = "chkPtdNewsletter" And aField.Result = "1" Then
myCategory = "Printed News"
Else
myCategory = "eNews"
End If

If aField.Name = "chk8HourTrainingYes" Then
Hour8Training = Val(aField.Result)
ElseIf aField.Name = "chk65HourTrainingYes" Then
Hour65Training = Val(aField.Result)
End If


If aField.Name = "NameField" Then
FName = aField.Result
ElseIf aField.Name = "Phone2Field" Then
HomeTelephone = aField.Result
ElseIf aField.Name = "PhoneField" Then
BusinessTelephone = aField.Result
ElseIf aField.Name = "MailingAddress" Then
MailAddress = aField.Result
End If

End If

Next

With objContact 'How do I direct the code to go into the Custom Folder?
.FullName = FName
.HomeTelephoneNumber = HomeTelephone
.BusinessTelephoneNumber = BusinessTelephone
.BusinessAddress = MailAddress
.Categories = myCategory
.UserProperties("8HourTraining") = Hour8Training
.UserProperties("65HourTraining") = Hour65Training
.Save
End With
Set objContact = Nothing
Set objOutlook = Nothing


End Sub

 

[Sue Mosher [MVP-Outlook]]

Use the Add method on the custom folder's Items collection to create the item:

Set objContact = oOlFolder.Items.Add

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



In the code below, form field data is leaving Word and going to an Outlook contact list. Everything works EXCEPT it puts the new contact in my default contact folder instead of the custom folder... can anyone identify what I did wrong?

Public Sub AddContact()
Dim objOutlook As New Outlook.Application

Dim myNameSpace As NameSpace
Set myNameSpace = objOutlook.GetNamespace("MAPI")
Dim oOlFolder As MAPIFolder
Set oOlFolder = myNameSpace.Folders("Custom Contacts").Folders("Speakers") 'Here is my folder called "Custom Contacts", which is really a pst file on it's own, with a subfolder for contact items called "Speakers"
Dim objContact As ContactItem
Set objContact = objOutlook.CreateItem(olContactItem)

Dim FName As String
Dim HomeTelephone As String
Dim BusinessTelephone As String
Dim MailAddress As String
Dim aField As FormField
Dim myCategory As String
Dim Hour8Training As Integer
Dim Hour65Training As Integer


For Each aField In ActiveDocument.FormFields
If Trim(aField.Result) <> "" Then
If aField.Name = "chkPtdNewsletter" And aField.Result = "1" Then
myCategory = "Printed News"
Else
myCategory = "eNews"
End If

If aField.Name = "chk8HourTrainingYes" Then
Hour8Training = Val(aField.Result)
ElseIf aField.Name = "chk65HourTrainingYes" Then
Hour65Training = Val(aField.Result)
End If


If aField.Name = "NameField" Then
FName = aField.Result
ElseIf aField.Name = "Phone2Field" Then
HomeTelephone = aField.Result
ElseIf aField.Name = "PhoneField" Then
BusinessTelephone = aField.Result
ElseIf aField.Name = "MailingAddress" Then
MailAddress = aField.Result
End If

End If

Next

With objContact 'How do I direct the code to go into the Custom Folder?
.FullName = FName
.HomeTelephoneNumber = HomeTelephone
.BusinessTelephoneNumber = BusinessTelephone
.BusinessAddress = MailAddress
.Categories = myCategory
.UserProperties("8HourTraining") = Hour8Training
.UserProperties("65HourTraining") = Hour65Training
.Save
End With
Set objContact = Nothing
Set objOutlook = Nothing


End Sub

 

[Eric Legault [MVP - Outlook]]

You have to put it into the non-default Contacts folder by either of these
methods:

- call objContact.Move oOlFolder
- or use Set objContact = oOlFolder.Items.Add("IPM.Contact")