• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2114
  • Last Modified:

LDAP Query Using Outlook VBA

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
NateR78
Asked:
NateR78
1 Solution
 
Chris BottomleyCommented:
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
 
NateR78Author Commented:
Thanks - I got it working
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Has Powershell sent you back into the Stone Age?

If managing Active Directory using Windows Powershell® is making you feel like you stepped back in time, you are not alone.  For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now