Copy Contact field to Appointment Custom Form Field

Status
Not open for further replies.

George Z

New Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
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"
 
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:
Dim objProp As Outlook.UserProperty
Set objProp = obj.UserProperties.Add("Customer Name", olText, True)
         objProp.Value = objContact.CompanyName
        obj.Save
 
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
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
C Copy Outlook contact field value to another field Outlook VBA and Custom Forms 1
B Outlook Business Contact Manager with SQL to Excel, User Defined Fields in BCM don't sync in SQL. Can I use VBA code to copy 1 field to another? BCM (Business Contact Manager) 0
O Outlook 365 - How to create / copy a new contact from an existing one? Using Outlook 5
F Copy and replace not update contact in another pst Using Outlook 0
H Blind copy and contact help Using Outlook 5
1 Where Can I get hold of a copy of Business Contact Manager BCM (Business Contact Manager) 4
K How to copy Contact Item to Clipboard and Paste as "VCF Link? Outlook VBA and Custom Forms 4
C Copy from one Profile to another Using Outlook 0
M "Attachment Detacher for Outlook" add in, does it update the server copy of the email? Using Outlook 1
C Outlook 365 Copy/Save Emails in Folder Outside Outlook to Show Date Sender Recipient Subject in Header Using Outlook 0
D Copy Appointment Body to Task Body Outlook VBA and Custom Forms 0
M copy field value to custom field Outlook VBA and Custom Forms 0
O In Agenda-view - How to copy an existing item months ahead or back? Using Outlook 0
C Move or copy from field to field Outlook VBA and Custom Forms 0
Z Copy specific email body text Outlook VBA and Custom Forms 0
B Need to Copy an email to a subfolder Outlook VBA and Custom Forms 2
S Copy Tasks/Reminders from Shared Mailbox to Personal Tasks/Reminders Outlook VBA and Custom Forms 0
A Cannot copy this folder because it may contain private items Using Outlook 0
C Copy Move item won't work Outlook VBA and Custom Forms 2
Z VBA to convert email to task, insert text of email in task notes, and attach copy of original email Outlook VBA and Custom Forms 4
Commodore Move turns into "copy" Using Outlook 3
J Copy to calendar function no longer working in outlook 365 Using Outlook 5
Commodore Folders always closed in move/copy items dialog box Using Outlook 3
N Outlook rules don't create a copy for bcc'ed emails Using Outlook 3
geofferyh Outlook 2010 How to Copy Outlook Attachment to a Specific Folder? Outlook VBA and Custom Forms 3
S Custom Form, copy user field data to message body Outlook VBA and Custom Forms 12
R Copy Outlook Public Folders to a File Server Shared Folder Using Outlook 0
K Outlook Rules: Move a Copy Using Outlook 4
oliv- HOW TO COPY /USE FOLDERS ICONS Outlook VBA and Custom Forms 2
E Copy e-mail body from outlook and insert into excel Outlook VBA and Custom Forms 3
B Copy/Move Exchange inbox to Pop inbox Using Outlook 4
R Sending email copy (*.msg file) of sent email if subject line contains specific string. Outlook VBA and Custom Forms 1
O Copy mails from many subfolders to 1 foldr Using Outlook 2
K ind specific Subject line from outlook and copy the content of the email body to exce Outlook VBA and Custom Forms 0
K How to find specific header and copy the mail body Using Outlook 0
J Copy or Export Outlook Mail to Excel Outlook VBA and Custom Forms 6
G How to Copy Multi Select Listbox Data to Appointment Outlook VBA and Custom Forms 3
Carrie Dickey Outlook 2016 created two calendars titled Calendar1 - appear to be a copy Using Outlook 2
P How to copy and append data from Outlook 2016 message into Excel 2016 workbook Using Outlook 0
Stilgar Relsik Create a rule to copy text from an email and paste it in the subject line. Using Outlook 1
R Macro to copy email to excel - Runtime Error 91 Object Variable Not Set Outlook VBA and Custom Forms 11
H Macro to Copy Specific content from Mail Body and Paste to Excel Outlook VBA and Custom Forms 4
M How to keep reccurence during copy tasks to calendar? Using Outlook 1
Diane Poremsky Copy New Appointments to Another Calendar using VBA Using Outlook 0
Diane Poremsky Use a macro to copy data in Outlook email to Excel workbook Using Outlook 0
C Copy Task to Non-Microsoft PIM "Rainlendar" Using Outlook 0
G VBA Copy draft email to a new email - attachments not copided Using Outlook 7
C Copy email to excel runtime error 5020 Using Outlook 5
I Copy email from folder to folder - FAILS Using Outlook 5
M Copy new appointments created in multiple shared calendars to another exchange calendar Outlook VBA and Custom Forms 1

Similar threads

Back
Top