Solved

Access VBA to get e-mail address from Outlook 2003 and 2010

Posted on 2011-03-07
11
3,377 Views
1 Endorsement
Last Modified: 2012-05-11
I need Access VBA to get the full e-mail address from Outlook versions 2003 and 2010.  I already have my companies phone book downloaded to my DB.  I have the Outlook unique Alias that every person gets.  Can I use this Alias to get the full e-mail address for each person?  It needs to work for both version 2003 and 2010 of Outlook.  

The VBA could be run once for the entire table and put into the e-mail addres field that I will create.
   or
Run each time the user picks an alias from the combobox (if it's not too slow).

I need this because I'm changing from a Outlook base e-mail system (CDO) to a SMTP system.
1
Comment
Question by:schmir1
11 Comments
 
LVL 39

Expert Comment

by:als315
ID: 35060135
Have you tried to link address book from outlook to access?
0
 

Author Comment

by:schmir1
ID: 35060169
Yes, that doesn't work for Outlook 2003 anymore on my new PC.  Don't know why.  Table comes up blank.

How do I do it for Outlook 2010?
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 35060680

External Data-->Import & Link-->More-->Outlook Folder-->Link to the Data Source...
Then select the Address book folder.
0
 

Author Comment

by:schmir1
ID: 35062792
My Win7 PC does display the Global Address List but it does NOT contain the Internet Address.  It has the e-mail address which is just some server info with the Outlook alias at the end.  For example:
/0=xxxecorg/ou=mit123/cn-Recpients/cn=schmir1

What I need is the Internet Address.  For example:
robert.schmitt@mycompany.com

I can look it up for one person in Outlook Properties in a field they call Internet Address.  How do I get this info for all 10,000 people in the address book?  Obviously, Outlook has the info somewhere.
0
 

Author Comment

by:schmir1
ID: 35063245
I find some references to OutlookApp.Session.  Would that be a way to get the SMTP Internet E-mail address?  I do have the Outlook alias to use to find the correct e-mail.
0
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 35066374
If you have a list of the exchange addresses, (ALias I am assuming) then it is possible using VBA to get the SMTP address for each of those users if that is indeed the requirement then are you comfortable creating a loop in Access to cycle through the aliases ... or do they they reside elsewhere, (I am not particularly competent in Access though Outlook i'm ok at).

I post a function, (I use it it quite a lot in solutions) that will take an exchange address and return the SMTP address and that therefore would need calling once for every entry ... it is an outlook function as structured but that is easy to adapt once we have access to the source data.

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 Comment

by:schmir1
ID: 35072730
I have got the alias that I need to pass your code and know how to code it in Access 2007 VBA.

I tried you code one a Outlook 2003 (Full version) PC and got the following two errors as marked in the comments:
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)  '***Object does not support this property or method ERROR
        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)       '***object variable or with variable ERROR
    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
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 35073094
Okay missed a bit!

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 = createobject("outlook.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)  '***Object does not support this property or method ERROR
        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)       '***object variable or with variable ERROR
    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 Comment

by:schmir1
ID: 35074770
Excellent.  Work for both my Outlook 2003 and 2010 needs.  And it doesn't require the now discontinued CDO.DLL.  Thanks very much for your help.
0
 

Author Closing Comment

by:schmir1
ID: 35074781
Just plugged it in and it worked.  How can you beat that.  Excellent answer.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 35079828
:o)

Albeit with a bit of a tweak but glad it helped.

Chris
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

QuickBooks® has a great invoice interface that we were happy with for a while but that changed in 2001 through no fault of Intuit®. Our industry's unit names are dictated by RUS: the Rural Utilities Services division of USDA. Contracts contain un…
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.

708 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

14 Experts available now in Live!

Get 1:1 Help Now