The code below was crapping out last night at the point noted below. This
morning it crapped out earlier in the code. I cannot figure out why for the
life of me it does. I do not believe that there's a limit to the number of
User Properties that can be created and have double checked that everything
matches up. The code will eventually import an Excel worksheet into Outlook.
I have been running it from within Excel to push the values to Outlook, would
it be better to run it from within Outlook and pull the values from Excel?

Help?

Sub createOutlookAppointmentFromId()
   
   Dim objOutlook As Object
   Dim newAppt As Object
   Dim nms As Outlook.Namespace
   Dim targetFolder As Object

   Set objOutlook = CreateObject("Outlook.application")
   Set nms = objOutlook.GetNamespace("MAPI")
   Set targetFolder = nms.Folders("Mailbox - David Holley").Folders("Show
Schedule Upload")
   
   'Use PickFolder to select target for import
   Set newAppt = objOutlook.CreateItem(olAppointmentItem)
 
   With newAppt.UserProperties
       .Add "Show Name", olText
       .Add "Job Number", olText
       .Add "Facility", olText
       .Add "Room", olText
       .Add "DP Color", olText
       .Add "AS Carpet", olText
       .Add "BT Package", olText
       .Add "Account Executive", olText
       .Add "DE Foreman", olText
       .Add "FR Foreman", olText
       .Add "XXX Foreman", olText
       .Add "SSX Foreman", olText
       .Add "ESX IH Rep", olText
       .Add "ESX SS Rep", olText
       .Add "RGN Move-In Start", olDateTime
       .Add "RGN Move-In End", olDateTime
       .Add "XXX Move-In Start", olDateTime
       .Add "XXX Move-In End", olDateTime
       .Add "Dealer Move-In Start", olDateTime
       .Add "Dealer Move-In End", olDateTime
       .Add "Month", olText
       .Add "Show Open", olDateTime
       .Add "Show Close", olDateTime
       .Add "Dealer Clear", olDateTime
       .Add "XXX Clear", olDateTime
   End With
   
   With newAppt
       .UserProperties(1) = "TEST SHOW NAME"
       .UserProperties(2) = "999999"
       .UserProperties(3) = "DISNEY'S GRAND FLORIDIAN"
       .UserProperties(4) = "Fantasia Ballroom"
       .UserProperties(5) = "Blue"
       .UserProperties(6) = "Green"
       .UserProperties(7) = "No Package"
       .UserProperties(8) = "AE"
       .UserProperties(9) = "DF"                   'CRAP OUT POINT
       .UserProperties(10) = "FF"
       .UserProperties(11) = "MIS"
       .UserProperties(12) = "SS"
       .UserProperties(13) = "ESIR"
       .UserProperties(14) = "ESSR"
       .UserProperties(15) = "10/01/2006 8:00 AM"
       .UserProperties(16) = "10/01/2006 8:00 PM"
       .UserProperties(17) = "10/02/2006 9:00 AM"
       .UserProperties(18) = "10/02/2006 9:00 PM"
       .UserProperties(19) = "10/03/2006 10:00 AM"
       .UserProperties(20) = "10/03/2006 10:00 PM"
       .UserProperties(21) = "2006 11 November"
       .UserProperties(22) = "11/1/2006 8:00 AM"
       .UserProperties(23) = "11/2/2006 8:01 AM"
       .UserProperties(24) = "12/30/2006 10:00 PM"
       .UserProperties(25) = "12/31/2006 11:59 PM"
       .Save
   End With
 
   Set targetFolder = Nothing
   Set nms = Nothing
   Set newAppt = Nothing
   Set objOutlook = Nothing
     
End Sub