Solved

How can i get all email address of all mails in an Folder in outlook 2007.

Posted on 2008-10-25
18
645 Views
Last Modified: 2012-05-05
Hi,

How can i get all email address of all mails in an Folder in outlook 2007.
Local mails from exchange are in a folder. When run script has to get all the email addresses from to a txt file.

Regards
Sharath
0
Comment
Question by:bsharath
  • 10
  • 8
18 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22804629
HOw about the following previously posted by BlueDevilFan

Chris
Sub ExtractEmail()

    Dim Mailobject As Object

    Dim olkRecipient As Outlook.Recipient

    Dim Folder As MAPIFolder

    ' Display select folder dialog

    Set Folder = Session.PickFolder()

    ' Create Text File

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set a = fs.CreateTextFile("c:\email addresses.txt", True)

    ' loop to read email address from mail items.

    For Each Mailobject In Folder.Items

        For Each olkRecipient In Mailobject.Recipients

            If olkRecipient.Type = olTo Then

                a.WriteLine olkRecipient.Address

            End If

        Next

    Next

    Set olkRecipient = Nothing

    Set Mailobject = Nothing

    a.Close

End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 22806459
Hi Chris

I dont just get the email addresses
I get this
/O=GROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=SHARATH
As these mails are within an exchange server they are resolved.
Can i get the full email addresses.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22806546
I believe so, I have a code block elsewhere to do this ... unless you get it complete before then i'll check on Tues ... sorry for delay on my part.

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 22806547
Ok Chris...
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22819609
Try the following extension.

1. Add the function from the snippet to the same module.
2. Modify line 14 above from:
                a.WriteLine olkRecipient.Address
to
                a.WriteLine GetSMTPAddress(olkRecipient.Name)

With a lot of luck it'll work ok ... a test on my machine did anyway.

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 oCon As ContactItem

Dim strKey As String

Dim oRec As Recipient

Dim strRet As String

Dim fldr As MAPIFolder

    'IF OUTLOOK VERSION IS >= 2007 THEN USES NATIVE OOM PROPERTIES AND METHODS

    On Error Resume Next

    Set fldr = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Folders.item("Random")

    If fldr Is Nothing Then

        Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Folders.Add "Random"

        Set fldr = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Folders.item("Random")

    End If

    On Error GoTo 0

    If CInt(Left(Application.Version, 2)) >= 12 Then

        Set oRec = 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(olContactItem)

    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 = Session.GetDefaultFolder(olFolderDeletedItems).Items.Find("[Subject]=" & strKey)

    If Not oCon Is Nothing Then oCon.Delete

ReturnValue:

    GetSMTPAddress = strRet

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 22819623
I get run time error 91
Object variable or with block variable not set

When debug goes here
0
 
LVL 11

Author Comment

by:bsharath
ID: 22819624
I get run time error 91
Object variable or with block variable not set

When debug goes here
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22819675
When debug goes where?

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 22819707
When debug goes here

  For Each olkRecipient In Mailobject.Recipients

Will the macro get me email id's of replies that i have got right?

I want the mail id's of users who have sent me a mail.

The txt file even though it errors populates some email id's most of them are my email id...
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 11

Author Comment

by:bsharath
ID: 22819708
When debug goes here

  For Each olkRecipient In Mailobject.Recipients

Will the macro get me email id's of replies that i have got right?

I want the mail id's of users who have sent me a mail.

The txt file even though it errors populates some email id's most of them are my email id...
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22819773
1. That line hasn't changed from when you ran it earlier? ... i.e. when you indicated that the script returns "/O=GROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=SHARATH"

CAn you post the code you are using now?

2. Testing acorrection for senders at the moment

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 22819781
Now i get just the email id's

Full code below

Sub ExtractEmail()

    Dim Mailobject As Object

    Dim olkRecipient As Outlook.Recipient

    Dim Folder As MAPIFolder

    ' Display select folder dialog

    Set Folder = Session.PickFolder()

    ' Create Text File

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set a = fs.CreateTextFile("D:\email addresses.txt", True)

    ' loop to read email address from mail items.

    For Each Mailobject In Folder.Items

        For Each olkRecipient In Mailobject.Recipients

            If olkRecipient.Type = olTo Then

               a.WriteLine GetSMTPAddress(olkRecipient.Name)

            End If

        Next

    Next

    Set olkRecipient = Nothing

    Set Mailobject = Nothing

    a.Close

End Sub
 

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 oCon As ContactItem

Dim strKey As String

Dim oRec As Recipient

Dim strRet As String

Dim fldr As MAPIFolder

    'IF OUTLOOK VERSION IS >= 2007 THEN USES NATIVE OOM PROPERTIES AND METHODS

    On Error Resume Next

    Set fldr = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Folders.Item("Random")

    If fldr Is Nothing Then

        Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Folders.Add "Random"

        Set fldr = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Folders.Item("Random")

    End If

    On Error GoTo 0

    If CInt(Left(Application.Version, 2)) >= 12 Then

        Set oRec = 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(olContactItem)

    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 = Session.GetDefaultFolder(olFolderDeletedItems).Items.Find("[Subject]=" & strKey)

    If Not oCon Is Nothing Then oCon.Delete

ReturnValue:

    GetSMTPAddress = strRet

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 22819782
Now i get just the email id's

Full code below

Sub ExtractEmail()

    Dim Mailobject As Object

    Dim olkRecipient As Outlook.Recipient

    Dim Folder As MAPIFolder

    ' Display select folder dialog

    Set Folder = Session.PickFolder()

    ' Create Text File

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set a = fs.CreateTextFile("D:\email addresses.txt", True)

    ' loop to read email address from mail items.

    For Each Mailobject In Folder.Items

        For Each olkRecipient In Mailobject.Recipients

            If olkRecipient.Type = olTo Then

               a.WriteLine GetSMTPAddress(olkRecipient.Name)

            End If

        Next

    Next

    Set olkRecipient = Nothing

    Set Mailobject = Nothing

    a.Close

End Sub
 

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 oCon As ContactItem

Dim strKey As String

Dim oRec As Recipient

Dim strRet As String

Dim fldr As MAPIFolder

    'IF OUTLOOK VERSION IS >= 2007 THEN USES NATIVE OOM PROPERTIES AND METHODS

    On Error Resume Next

    Set fldr = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Folders.Item("Random")

    If fldr Is Nothing Then

        Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Folders.Add "Random"

        Set fldr = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Folders.Item("Random")

    End If

    On Error GoTo 0

    If CInt(Left(Application.Version, 2)) >= 12 Then

        Set oRec = 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(olContactItem)

    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 = Session.GetDefaultFolder(olFolderDeletedItems).Items.Find("[Subject]=" & strKey)

    If Not oCon Is Nothing Then oCon.Delete

ReturnValue:

    GetSMTPAddress = strRet

End Function

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22819862
With the above code you are getting the runtime error?

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 22819866
Yes....
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 22819937
Personally the following is giving me issues with encrypted emails ... hpefully not an issue for you.

Please replace the function with the following and see how it looks,

Chris
Sub ExtractEmail()

Dim Mailobject As Object

Dim olkRecipient As Outlook.Recipient

Dim Folder As MAPIFolder

Dim fs As Object

Dim a As Object

Dim mai As mailitem

    ' Display select folder dialog

    Set Folder = Session.PickFolder()

    ' Create Text File

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set a = fs.CreateTextFile("c:\email addresses.txt", True)

    ' loop to read email address from mail items.

    For Each Mailobject In Folder.Items

        If Mailobject.Class = olMail Then   ' typename(mailobject) = "MailItem"

            On Error GoTo assumeEncrypted

            If Mailobject.SenderEmailAddress <> "" Then

                If Mailobject.SenderEmailType = "EX" Then

                        a.WriteLine GetSMTPAddress(Mailobject.SenderEmailAddress)

                Else

                        a.WriteLine Mailobject.SenderEmailAddress

                End If

            End If

assumeEncrypted:

        End If

    Next

    Set olkRecipient = Nothing

    Set Mailobject = Nothing

    a.Close

End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 22820054
Thanks a lot Chris worked perfect...
Any help on this please... Need it a bit urgent
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_23839836.html
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22820218
I will as promised look to the request now that the functionality of the GetSMTPAddress function is all but sorted.  Not be immediate though i'm afraid.

Chris
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

When we want to run, execute or repeat a statement multiple times, a loop is necessary. This article covers the two types of loops in Python: the while loop and the for loop.
Use these top 10 tips to master the art of email signature design. Create an email signature design that will easily wow recipients, promote your brand and highlight your professionalism.
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …

705 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

19 Experts available now in Live!

Get 1:1 Help Now