Solved

LDAP Query Using Outlook VBA

Posted on 2011-02-21
2
1,917 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
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

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Many people use more than one email account and so it becomes difficult for them to manage them when they use separate accounts,  so, in this article, I have shared an easy way to add Other Mail Accounts in your Google Inbox. It helps to combine all…
This article shows the method of using the Resultant Set of Policy Tool to locate Group Policy that applies a particular setting.
This tutorial will walk an individual through the steps necessary to join and promote the first Windows Server 2012 domain controller into an Active Directory environment running on Windows Server 2008. Determine the location of the FSMO roles by lo…
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

685 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