Solved

LDAP Query Using Outlook VBA

Posted on 2011-02-21
2
1,839 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
Comment Utility
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
Comment Utility
Thanks - I got it working
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Set OWA language and time zone in Exchange for individuals, all users or per database.
Use email signature images to promote corporate certifications and industry awards.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This tutorial will walk an individual through the process of transferring the five major, necessary Active Directory Roles, commonly referred to as the FSMO roles to another domain controller. Log onto the new domain controller with a user account t…

762 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

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now