Cannot Figure Out This VBA

Alexa

New Member
Outlook version
Outlook 2007
Email Account
Exchange Server
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
 

Alexa

New Member
Outlook version
Outlook 2007
Email Account
Exchange Server
This code will do exactly what I need and I cannot find another with exactly the same functions.
 

Similar threads

Top