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