Created
July 14, 2015 09:04
-
-
Save Clijsters/471e1e05f1ea606bc349 to your computer and use it in GitHub Desktop.
A (little messy) VBA-Script for Outlook to add Username to each Mail in Inbox.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Private WithEvents colItemsPersonal As Outlook.Items | |
Private WithEvents HotlineItems As Outlook.Items | |
Dim strUserField As String | |
Dim strPersonal As String | |
Dim strShared As String | |
'''Listen on two Mailboxes and supplement MailItem with senders Alias. | |
'''It's nice if you are using concern wide IDs (CWIDs) to identify your users. | |
Private Sub Application_Startup() | |
strUserField = "samName" | |
strPersonal = "dominique.clijsters@somedomain.com" | |
strShared = "MyTicketSystem" | |
Dim oApp As Outlook.Application | |
Dim oNS As Outlook.NameSpace | |
Dim objInbox As Outlook.MAPIFolder | |
Dim objSharedInbox As Outlook.MAPIFolder | |
Set oApp = Outlook.Application | |
Set oNS = oApp.GetNamespace("MAPI") | |
Set objInbox = oNS.Folders(strPersonal) | |
Set colItemsPersonal = objInbox.Folders("Inbox").Items | |
Set objSharedInbox = oNS.Folders(strShared) | |
Set HotlineItems = objSharedInbox.Folders("Inbox").Items | |
End Sub | |
'Supplements MailItem with samName entry ("Alias", also known as samAccountName) | |
Sub SupplementItem(ByVal objMail As Object) | |
On Error GoTo ErrorHandler | |
Dim Msg As Outlook.MailItem | |
If TypeName(objMail) = "MailItem" Then | |
Set Msg = objMail | |
Set objProperty = Msg.UserProperties.Add(strUserField, Outlook.OlUserPropertyType.olText) | |
'Checks whether the sender of Msg is an Exchange compatible User. If True, use Alias property as samName | |
If Msg.Sender.AddressEntryUserType = olExchangeUserAddressEntry Or _ | |
Msg.Sender.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then | |
ExUsr = Msg.Sender.GetExchangeUser() | |
valueToSet = Msg.Sender.GetExchangeUser().Alias | |
objProperty.Value = valueToSet | |
Else | |
'valueToSet = "External User / unresolvable" | |
End If | |
objProperty.Value = valueToSet | |
Msg.Save | |
End If | |
ProgramExit: | |
Exit Sub | |
ErrorHandler: | |
MsgBox "Fehler:" & vbCrLf & Err.Number & " - " & Err.Description | |
Resume ProgramExit | |
End Sub | |
'Occurs when a new Item is created in peronal Inbox | |
Private Sub colItemsPersonal_ItemAdd(ByVal objMail As Object) | |
SupplementItem objMail | |
End Sub | |
'Occurs when a new Item is created in shared Inbox | |
Private Sub HotlineItems_ItemAdd(ByVal objMail As Object) | |
SupplementItem objMail | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment