Solved

LDAP Query Using Outlook VBA

Posted on 2011-02-21
2
1,932 Views
Last Modified: 2012-05-11
I am using the following script that I found online (with a few minor changes to suit my specific needs) in Outlook to submit certain emails I receive to a helpdesk ticketing system.  The problem with this script is that the "SenderEmailAddress" property of the Outlook.MailItem is actually pulling the "legacyExchangeDN" attribute from Active Directory, and that does not always contain the correct username (e.g., if an AD user got renamed at some point, for whatever reason that attribute never changes).

The email address of the user submitting the ticket should be stored in the "emailUser" string, which is being derived from objItem.SenderEmailAddress and is sometimes wrong because of this problem.

My question should be pretty simple for you VB gurus... I need to modify this script so that "emailUser" is set to be whatever the user's primary e-mail address is.  I'm guessing you can just query AD and find the user object whose name is equal to the Outlook.MailItem.Sender property... but alas, I do not know how to build that query.

Any ideas?





Sub Helpdesk()
Dim helpdeskaddress As String
Dim objMail As Outlook.MailItem
Dim strbody As String
Dim oldmsg As String
Dim emailUser As String
Dim objItem As Outlook.MailItem

' Set this variable as your helpdesk e-mail address
helpdeskaddress = "helpdesk@company.com"

Set objItem = GetCurrentItem()
Set objMail = objItem.Forward

'get the username portion of the sender email address by parsing LDAP string
If (InStr(1, objItem.SenderEmailAddress, "CN=") > 0) Then
  emailUser = (Right(objItem.SenderEmailAddress, (Len(objItem.SenderEmailAddress) - 57))) & "@company.com"
Else
  emailUser = objItem.SenderEmailAddress
End If

'adds the senders e-mail address as the created by object for the ticket and appends the message body
strbody = "#created by " & emailUser & vbNewLine & vbNewLine & objItem.Body

objMail.To = helpdeskaddress
objMail.Subject = objItem.Subject
objMail.Body = strbody

' remove the comment from below to display the message before sending
'objMail.Display

'Automatically Send the ticket
objMail.Send

Set objItem = Nothing
Set objMail = Nothing
End Sub

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = _
objApp.ActiveInspector.CurrentItem
Case Else
End Select
End Function

Open in new window

0
Comment
Question by:NateR78
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 34948996
Whilst I no longer have access to an AD I used to use the following function i.e.

'get the username portion of the sender email address by parsing LDAP string
If (InStr(1, objItem.SenderEmailAddress, "CN=") > 0) Then
  emailUser = (Right(objItem.SenderEmailAddress, (Len(objItem.SenderEmailAddress) - 57))) & "@company.com"
Else
  emailUser = objItem.SenderEmailAddress
End If

becomes

emailUser = GetSMTPAddress(objItem.SenderEmailAddress)

See if it helps you?

Chris
Function GetSMTPAddress(ByVal strAddress As String)
' As supplied by Vikas Verma ... see
' http://blogs.msdn.com/vikas/archive/2007/10/24/oom-getting-primary-smtp-address-from-x400-x500-sip-ccmail-etc.aspx
Dim olApp As Object
Dim oCon As Object
Dim strKey As String
Dim oRec As Object
Dim strRet As String
Dim fldr As Object
    'IF OUTLOOK VERSION IS >= 2007 THEN USES NATIVE OOM PROPERTIES AND METHODS
    On Error Resume Next
    Set olApp = Application
    Set fldr = olApp.GetNamespace("MAPI").GetDefaultFolder(10).folders.Item("Random")
    If fldr Is Nothing Then
        olApp.GetNamespace("MAPI").GetDefaultFolder(10).folders.Add "Random"
        Set fldr = olApp.GetNamespace("MAPI").GetDefaultFolder(10).folders.Item("Random")
    End If
    On Error GoTo 0
    If CInt(Left(olApp.Version, 2)) >= 12 Then
        Set oRec = olApp.Session.CreateRecipient(strAddress)
        If oRec.Resolve Then
            strRet = oRec.AddressEntry.GetExchangeUser.PrimarySmtpAddress
        End If
    End If
    If Not strRet = "" Then GoTo ReturnValue
    'IF OUTLOOK VERSION IS < 2007 THEN USES LITTLE HACK
    'How it works
    '============
    '1) It will create a new contact item
    '2) Set it's email address to the value passed by you, it could be X500,X400 or any type of email address stored in the AD
    '3) We will assign a random key to this contact item and save it in its Fullname to search it later
    '4) Next we will save it to local contacts folder
    '5) Outlook will try to resolve the email address & make AD call if required else take the Primary SMTP address from its cache and append it to Display name
    '6) The display name will be something like this " ( email.address@server.com )"
    '7) Now we need to parse the Display name and delete the contact from contacts folder
    '8) Once the contact is deleted it will go to Deleted Items folder, after searching the contact using the unique random key generated in step 3
    '9) We then need to delete it from Deleted Items folder as well, to clean all the traces
    Set oCon = fldr.items.Add(2)
    oCon.Email1Address = strAddress
    strKey = "_" & Replace(Rnd * 100000 & Format(Now, "DDMMYYYYHmmss"), ".", "")
    oCon.FullName = strKey
    oCon.Save
    strRet = Trim(Replace(Replace(Replace(oCon.Email1DisplayName, "(", ""), ")", ""), strKey, ""))
    oCon.Delete
    Set oCon = Nothing
    Set oCon = olApp.Session.GetDefaultFolder(3).items.Find("[Subject]=" & strKey)
    If Not oCon Is Nothing Then oCon.Delete
ReturnValue:
    GetSMTPAddress = strRet
End Function

Open in new window

0
 

Author Closing Comment

by:NateR78
ID: 34952447
Thanks - I got it working
0

Featured Post

Office 365 Training for Admins - 7 Day Trial

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains the steps required to use the default Photos screensaver to display branding/corporate images
This article demonstrates probably the easiest way to configure domain-wide tier isolation within Active Directory. If you do not know tier isolation read https://technet.microsoft.com/en-us/windows-server-docs/security/securing-privileged-access/s…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…
Suggested Courses

734 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question