Cannot Get Outlook UDFs to carry over in Macro

Hi All, this is my first time posting to this site, but I'm hoping you can help me. I've been unsuccessful in trying to modify this macro so that the user-defined fields I've built in a custom outlook form will carry over into recurring meeting makers. The code performs very well when it comes to carrying over the standard form values, and it also converts the standard form to my template, but unfortunately, it does not carry over the values in my custom form fields. I've tried multiple iterations, with no luck. Any help would be much appreciated! I've bolded the portion where my code is erroring out. Thank you!

Code:

---

Sub ConvertRecurring()    Dim CalFolder As Outlook.MAPIFolder
    Dim CalItems As Outlook.Items
    Dim ResItems As Outlook.Items
    Dim sFilter, strSubject As String
    Dim iNumRestricted As Integer
    Dim itm, newAppt As Object
    Dim tStart, tEnd As Date
    Dim recAppt As Object
    Dim objProp As Outlook.UserProperty
   
       
   
   
    ' Use the selected calendar folder
    Set CalFolder = Application.ActiveExplorer.CurrentFolder
   
    Set recAppt = Application.ActiveExplorer.Selection.Item(1)
    ' Get all of the appointments in the folder
    Set CalItems = CalFolder.Items
   
    ' Sort all of the appointments based on the start time
    CalItems.Sort "[Start]"
   
    ' Include the recurrences from the selected date forward
    CalItems.IncludeRecurrences = True
   
    ' Pick up the Start Date of the selected appointment occurrence
    ' Use a List view to get all occurrences
    tStart = Format(recAppt.Start, "Short Date")
   
    ' macro limits all appt to 360 days from now
    ' so you can end a series early
    tEnd = Format(Now + 360, "Short Date")
   
        ' Pick up the selected appointment's subject
            strSubject = recAppt.Subject
           
        'create the Restrict filter
        sFilter = "[Start] >= '" & tStart & "'" & " And [End] < '" & tEnd & "' And  [IsRecurring]  = True And [Subject] = " & Chr(34) & strSubject & Chr(34)
       
        ' Apply the filter to the collection
        Set ResItems = CalItems.Restrict(sFilter)
       
        iNumRestricted = 0
       
        'Loop through the items in the collection.
        For Each itm In ResItems
            iNumRestricted = iNumRestricted + 1
       


    Set newAppt = ActiveExplorer.CurrentFolder.Items.Add(olAppointmentItem)
    newAppt.MessageClass = "IPM.Appointment.PMAppointment-v4"
       
 
    With newAppt
   
    .Start = itm.Start
    .End = itm.End
    .Subject = itm.Subject
    .Body = itm.Body
    .Location = itm.Location
    .Categories = itm.Categories
    .ReminderSet = False
 
    .Save
       
        'calling user-defined fields from form
    Set objProp = newAppt.UserProperties.Add("ProjectName", olText, True)
    objProp.Value = itm.UserProperties("ProjectName").Value
      .Save
   
    End With
   
   
    ' Copies attachments to each appointment.
    If itm.Attachments.Count > 0 Then
        CopyAttachments itm, newAppt
    End If
   
    newAppt.Save
   
        Next
       
        ' Display the actual number of appointments created
        MsgBox (iNumRestricted & " appointments were created"), vbOKOnly, "Convert Recurring Appointments"
       
        Set itm = Nothing
        Set newAppt = Nothing
        Set ResItems = Nothing
        Set CalItems = Nothing
        Set CalFolder = Nothing
        Set objProp = Nothing
       
        End Sub
       
Sub CopyAttachments(objSourceItem, objTargetItem)


Set fso = CreateObject("Scripting.FileSystemObject")
Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
strPath = fldTemp.Path & "\"
For Each objAtt In objSourceItem.Attachments
    strFile = strPath & objAtt.FileName
    objAtt.SaveAsFile strFile
    objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
    fso.DeleteFile strFile
Next


Set fldTemp = Nothing
Set fso = Nothing


End Sub

---