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