1. Here's a thread that needs an answer: Outlook custom fields "events"
    Dismiss Notice

Copy Contact field to Appointment Custom Form Field

Discussion in 'Outlook VBA and Custom Forms' started by George Z, Mar 9, 2017.

  1. George Z

    George Z

    New Member
    This is proving to be more challenging than I expected. Via the help of this forum I have a custom appointment form and use a VBA macro to copy data from contact fields, to the default appointment fields.

    How do I copy the "Company" field (from contacts) to a text box field in my custom appointment form via the VBA macro? As you can see in my code below I am already copying the "Company Name" to the Appt Subject Field. However I am unable to get this copied to the custom form field.

    From what I am seeing changing a value is something like this:

    MyItem.UserProperties.Find("Customer Name").Value = "objContact.CompanyName".



    Sub CreateMeetingatContactLocation()

    Dim oOL As Outlook.Application
    Dim NS As Outlook.NameSpace
    Dim objOwner As Outlook.Recipient
    Dim objAppt As Outlook.AppointmentItem
    Dim objAppointment As Outlook.AppointmentItem
    Dim objContact As Outlook.ContactItem
    Dim strPhone As String
    Dim strBody As String


    Set NS = Application.GetNamespace("MAPI")
    Set objOwner = NS.CreateRecipient("customerdb@beatonindustrial.com")
    objOwner.Resolve

    If objOwner.Resolved Then
    'MsgBox objOwner.Name
    Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
    End If

    Set oOL = Outlook.Application
    Set objAppt = newCalFolder.Items.Add("IPM.Appointment.Beaton Service Form 4.9")
    Set objContact = oOL.ActiveExplorer.Selection.Item(1)

    ' Use Company for Location
    If objContact.CompanyName <> "" Then
    objAppt.Subject = inputdata & " , " & inputdata5 & ", " & objContact.CompanyName & ", - OR - " & objContact.FullName & " , Phone: " & objContact.BusinessTelephoneNumber & " , Cell: " & objContact.MobileTelephoneNumber

    ' Use Business address if available, else home address
    If objContact.BusinessAddress <> "" Then
    objAppt.Location = objContact.BusinessAddressStreet & "," & objContact.BusinessAddressCity & "," & objContact.BusinessAddressState & "," & objContact.BusinessAddressPostalCode
    strPhone = objContact.BusinessTelephoneNumber
    Else

    objAppt.Location = objContact.HomeAddressStreet & ", " & objContact.HomeAddressCity & " " & objContact.HomeAddressState & " " & objContact.HomeAddressPostalCode
    strPhone = objContact.HomeTelephoneNumber


    MyItem.UserProperties.Find("Customer Name").Value = "objContact.CompanyName"
     
  2. Diane Poremsky

    Diane Poremsky

    Senior Member
    This won't have quotes: "objContact.CompanyName"

    See if this works:
    MyItem.UserProperties("Customer Name") = objContact.CompanyName

    if the field doesn't yet exist, use this to create the field and add to it:
    Code (Text):
    Copy Source
    Dim objProp As Outlook.UserProperty
    Set objProp = obj.UserProperties.Add("Customer Name", olText, True)
             objProp.Value = objContact.CompanyName
            obj.Save
     
  3. George Z

    George Z

    New Member
    So so long getting back to you. Could not get either working. I tried to figure it out today and Friday last week without luck. I have created the field "Customer Name" as a text field on my custom form. Was not 100% if I had to Dim the MyItem so I tried with and without the Dim. Below is my full code as I have it now. Let me know if you seen anything suspect. Macro runs without error though no company name in the company name field.

    Sub CreateMeetingatContactLocation()

    Dim oOL As Outlook.Application
    Dim NS As Outlook.NameSpace
    Dim objOwner As Outlook.Recipient
    Dim objAppt As Outlook.AppointmentItem
    Dim objAppointment As Outlook.AppointmentItem
    Dim objContact As Outlook.ContactItem
    Dim strPhone As String
    Dim strBody As String
    Dim myItem As Outlook.UserProperty


    Set NS = Application.GetNamespace("MAPI")
    Set objOwner = NS.CreateRecipient("customerdb@beatonindustrial.com")
    objOwner.Resolve

    If objOwner.Resolved Then
    'MsgBox objOwner.Name
    Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
    End If

    Set oOL = Outlook.Application
    Set objAppt = newCalFolder.Items.Add("IPM.Appointment.Beaton Service Form 4.9")
    Set objContact = oOL.ActiveExplorer.Selection.Item(1)




    inputdata = InputBox("Please Enter Service Technican and Van Number in the FollowinG Format 14 MM/TS")
    inputdata1 = InputBox("Please Enter a Descpiption of the Problem")
    inputdata2 = InputBox("If a Man Lift is Required to Complete Service please note if lift will be provided by Beaton or Customer. If no Manlift is Needed enter Not Required")
    inputdata3 = InputBox("Please Enter Company Hours of Operation to Complete Service")
    inputdata4 = InputBox("Please Enter Location and Status of Required Parts if Applicable. Enter N/A if Not Applicable.")
    inputdata5 = InputBox("Please Enter the Priority Level of Equipment Failure and Date Customer is Expecting Service")
    inputdata6 = InputBox("Please Enter any Other Additional Notes Relevant to Service Request, Customer Expectation, and or Technical Details")
    inputdata7 = InputBox("Add Dropbox Link for any Related File Attachments")

    ' Use Company for Location
    If objContact.CompanyName <> "" Then
    objAppt.Subject = inputdata & " , " & inputdata5 & ", " & objContact.CompanyName & ", - OR - " & objContact.FullName & " , Phone: " & objContact.BusinessTelephoneNumber & " , Cell: " & objContact.MobileTelephoneNumber

    ' Use Business address if available, else home address
    If objContact.BusinessAddress <> "" Then
    objAppt.Location = objContact.BusinessAddressStreet & "," & objContact.BusinessAddressCity & "," & objContact.BusinessAddressState & "," & objContact.BusinessAddressPostalCode
    strPhone = objContact.BusinessTelephoneNumber
    Else

    objAppt.Location = objContact.HomeAddressStreet & ", " & objContact.HomeAddressCity & " " & objContact.HomeAddressState & " " & objContact.HomeAddressPostalCode
    strPhone = objContact.HomeTelephoneNumber


    myItem.UserProperties("Customer Name") = objContact.CompanyName


    End If

    ' Add contact's name and phone number to the body
    objAppt.Body = "DESCRIPTION OF PROBLEM: " & inputdata1 & vbNewLine & vbNewLine & "MANLIFT: " & inputdata2 & vbNewLine & vbNewLine & "HOURS OF OPERATION: " & inputdata3 & vbNewLine & vbNewLine & "REQUIRED PARTS AND STATUS: " & inputdata4 & vbNewLine & vbNewLine & "ADDITIONAL NOTES: " & inputdata6 & vbNewLine & vbNewLine & "FILE ATTACHMENTS: " & inputdata7

    objAppt.Display




    Set objAppointment = Nothing
    If objAppointment Is Nothing Then
    With objAppt
    .AllDayEvent = True
    .BusyStatus = olBusy




    End With
    End If

    Set objContact = Nothing
    Set oOL = Nothing

    End If

    End Sub
     
Loading...

Share This Page