Hello there - I cannot figure out how to use this VBA. It is actually a "ready-to-use" script that I took from offline but I am unsure how to use it as I am a learning, VBA-Novice.
Please help me if any of you know... Thank you!
Private WithEvents m_Items As Outlook.Items
Private Sub Application_Startup()
Set m_Items = Application.Session.GetDefaultFolder(olFolderCalendar).Items
End Sub
Private Sub m_Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.AppointmentItem Then
AddContactInfo Item
End If
End Sub
Private Sub m_Items_ItemChange(ByVal Item As Object)
If TypeOf Item Is Outlook.AppointmentItem Then
AddContactInfo Item
End If
End Sub
Private Sub AddContactInfo(Appt As Outlook.AppointmentItem)
On Error GoTo ERR_HANDLER
Dim Link As Outlook.Link
Dim Contact As Outlook.ContactItem
Dim Adr As String
Static Busy As Boolean
If Busy Then Exit Sub Else Busy = True
If Appt.Location = "" Then
If Appt.Links.Count Then
Set Link = Appt.Links(1)
If Not Link.Item Is Nothing Then
Set Contact = Link.Item
If Not Contact Is Nothing Then
Adr = Contact.MailingAddress
Adr = Replace(Adr, vbCrLf, ", ")
If Right$(Adr, 2) = ", " Then
Adr = Left$(Adr, Len(Adr) - 2)
End If
Appt.Location = Adr
Appt.Save
End If
End If
End If
End If
ERR_HANDLER:
Busy = False
End Sub
Please help me if any of you know... Thank you!
Private WithEvents m_Items As Outlook.Items
Private Sub Application_Startup()
Set m_Items = Application.Session.GetDefaultFolder(olFolderCalendar).Items
End Sub
Private Sub m_Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.AppointmentItem Then
AddContactInfo Item
End If
End Sub
Private Sub m_Items_ItemChange(ByVal Item As Object)
If TypeOf Item Is Outlook.AppointmentItem Then
AddContactInfo Item
End If
End Sub
Private Sub AddContactInfo(Appt As Outlook.AppointmentItem)
On Error GoTo ERR_HANDLER
Dim Link As Outlook.Link
Dim Contact As Outlook.ContactItem
Dim Adr As String
Static Busy As Boolean
If Busy Then Exit Sub Else Busy = True
If Appt.Location = "" Then
If Appt.Links.Count Then
Set Link = Appt.Links(1)
If Not Link.Item Is Nothing Then
Set Contact = Link.Item
If Not Contact Is Nothing Then
Adr = Contact.MailingAddress
Adr = Replace(Adr, vbCrLf, ", ")
If Right$(Adr, 2) = ", " Then
Adr = Left$(Adr, Len(Adr) - 2)
End If
Appt.Location = Adr
Appt.Save
End If
End If
End If
End If
ERR_HANDLER:
Busy = False
End Sub