Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Export Sent to addresses

Posted on 2010-11-22
21
Medium Priority
?
487 Views
Last Modified: 2012-05-10
Can anyone supply me with a script which can export to txt or csv all sent to Email addresses from my outlook 2003?

In this script i would need the output to be a clean format. Outlook is connected to exchange, therefore when i try to do a regular export, its very messy with CN= blah/blah/blah.com...

I just need all addresses clean like youremail@youremail.com


0
Comment
Question by:alexr54
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 8
  • 4
  • +1
21 Comments
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 34196842
Please click the "Request Attention" link and ask that the Exchange Server zone be added to this Question.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34197352
How about the following?

Chris
Sub getrecip()
Dim dict As Object
Dim mai As Object
Dim recip As Recipient
Dim str As String
Dim outfile As Object
Dim arr As Variant
Dim itm As Variant

   Set dict = CreateObject("scripting.dictionary")
   dict.CompareMode = vbTextCompare
   For Each mai In Application.Session.GetDefaultFolder(olFolderSentMail).items
       If mai.Class = olMail Then
           Debug.Print mai.subject
           On Error GoTo getnext
           For Each recip In mai.Recipients
               str = getSMTPaddress(recip.Address)
               If str <> "" And Not dict.exists(str) Then dict.Add str, str
           Next
getnext:
           Set mai = Nothing
       End If
   Next
   Set outfile = getTextFile("c:\deleteme\", "gashisme.txt")
   arr = dict.items
   For Each itm In arr
       outfile.WriteLine itm
   Next
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

Function getTextFile(outputPath As String, outputFileName As String) As Object
'    Set outputfile = getTextFile("c:\deleteme22\sub2\temp", "gashisme.txt")
'    outputfile.WriteLine "Something for me"
'    outputfile.Close
Dim outputfile As Object
Dim fso As Object
Dim pathComponents() As String
Dim pathComponent As Integer
Dim fldr As String

   If Right(outputPath, 1) = "\" Then outputPath = Left(outputPath,
Len(outputPath) - 1)
   Set fso = CreateObject("Scripting.FileSystemObject")
   pathComponents = Split(outputPath, "\")
   For pathComponent = 0 To UBound(pathComponents)
       If pathComponent <> 0 Then
           fldr = fldr & "\"
       End If
       fldr = fldr & pathComponents(pathComponent)
       If Not fso.FolderExists(fldr) Then
           fso.CreateFolder fldr
       End If
   Next
   Set outputfile = fso.CreateTextFile(outputPath & "\" & outputFileName, True)
   outputfile.WriteLine "File Initialised on " & Format(Date, "dd mmm
yyyy") & " at " & Format(Time(), "hh:mm")
   outputfile.WriteLine "========================================"
   outputfile.WriteLine ""
   Set getTextFile = outputfile

End Function

Open in new window

0
 
LVL 2

Author Comment

by:alexr54
ID: 34202023
Hi Chris,

Can you explain what this does? And what is it looking for and taking from?
0
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.

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34202763
It cycles around every email in your sent folder and then every recipient therein and creates a file with the email addys for them all.

Chris
0
 
LVL 2

Author Comment

by:alexr54
ID: 34205502
Getting line 2 char 10, expected end of statement.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34206116
How are you running this ... for that error I suspect as a VBS - and in which case I need to make a number of changes.

ALternatively insert it into a code module in outlook and it will run from there:

Chris


To Create a macro:
------------------

Alt + F11 to open the macro editor

  For User Code:
     Insert | Module to insert a code module into the project
     In the project tree select the module.
     Insert the required macro(s) into the selected module, ('Module1' or similar)

Close the Visual Basic Editor.

To run a macro:
---------------

Alt + F8
Select the macro
Select 'Run'

Check Security as appropriate:
------------------------------

In the application select Tools | Macro | Security
=========================
2003 and earlier
-------------------------
      : Select Medium
      : Select OK
=========================

==================================================================================
2007
----------------------------------------------------------------------------------
      : Outlook Application - Warnings for all Macros
----------------------------------------------------------------------------------
      : All Other APplications - Enable a trusted location and inhibit macros otherwise so do both!
      : Disable Macros
            Office Button, (top left of the screen)
            Options
            Trust Centre
            Trust Centre Settings
            MAcro Settings
            Disable All MAcros with warnings
      : Enable Trusted Locations
            Office Button, (top left of the screen)
            Options
            Trust Centre
            Trust Centre Settings
            Trusted Locations
            Add a preferred location
            ENSURE YOUR FILE IS IN A TRUSTED LOCATION
            Re-open to ensure it is recognised if the above has been changed
            
      : Select OK
==================================================================================
0
 
LVL 13

Expert Comment

by:gbanik
ID: 34214301
Try putting this code in your Outlook VBA Project and running it. It would create a CSV file in your C:\
Public Sub FetchAllEmailAddress()
Dim oDefFolderType As OlDefaultFolders
oDefFolderType = olFolderSentMail

Dim oFolder As Folder, olNS As Outlook.NameSpace, oMailItem As MailItem, obj, nCtr As Integer, sTemp As String
Dim fso As New Scripting.FileSystemObject, txt As TextStream, oRec As Recipient

Set olNS = Application.GetNamespace("MAPI")
Set oFolder = olNS.GetDefaultFolder(oDefFolderType)
Set txt = fso.OpenTextFile("C:\SentMailAddr_" & Format(Now(), "dd-mmm-yy-hh-m-s") & ".csv", ForWriting, True)

For Each obj In oFolder.Items
    sTemp = ""
    If TypeName(obj) = "MailItem" Then
        Set oMailItem = obj
        For Each oRec In oMailItem.Recipients
            sTemp = sTemp & "," & oRec.Address
        Next
        If Len(sTemp) > 0 Then txt.WriteLine Mid(sTemp, 2)
    End If
Next

txt.Close
Set txt = Nothing
Set fso = Nothing
End Sub

Open in new window

0
 
LVL 13

Expert Comment

by:gbanik
ID: 34214307
The above code is applicable to any folder, not just Sent Items. Just change the value of the variable "oDefFolderType" to your desired folder.
0
 
LVL 2

Author Comment

by:alexr54
ID: 34245784
I am getting

Compile error:

User-defined type not defined
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34245947
Which code are you running and have you a response to my question about code placement?

Chris
0
 
LVL 2

Author Comment

by:alexr54
ID: 34248725
I am running through outlook 2003 macros.

This was Gbanik's code.

Also your code throws an error:

Compile error:

Arguement not optional and highlights

Function getSMTPaddress(ByVal strAddress As String)
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34248848
I've just run my code agaian with no error - can you confirm it highlights the line

Function getSMTPaddress(ByVal strAddress As String)

I really cannot see how that can happen ... also can you tell me anything about the mail folder selected in outlook before you run it, and do you get anything created in the outlput file at all?

Chris
0
 
LVL 2

Author Comment

by:alexr54
ID: 34248970
Its very possible i am doing something wrong here since i am completely new to outlook macros.

There is no file made at all. I am running this while in "Sent Items" in outlook 2003.

When i run the macro.

Compile Error:

Argument not optional

When i hit ok,

the line "Function getSMTPaddress(ByVal strAddress As String)" get highlighted yellow. And still no file.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34249367
Can you get a snapshot of the code where it's loaded?

Chris
0
 
LVL 2

Author Comment

by:alexr54
ID: 34249481
error
0
 
LVL 13

Expert Comment

by:gbanik
ID: 34258775
Hi alexr54,

Sorry could not appear earlier. The only problem that you are encountering in my code is that the code expects a reference to the Microsoft Scripting Runtime. Thats it!!

Please add the same in your references and watch it run!

To add to references, got VBA Editor...
Goto Tools > References > Choose "Microsoft Scripting Runtime" > choose OK.

Run the macro again!
0
 
LVL 13

Assisted Solution

by:gbanik
gbanik earned 400 total points
ID: 34258857
If you need a non-reference code explicitly for some reason, here u are....

Replace this

Dim oFolder As Folder, olNS As Outlook.NameSpace, oMailItem As MailItem, obj, nCtr As Integer, sTemp As String
Dim fso As New Scripting.FileSystemObject, txt As TextStream, oRec As Recipient

with

Dim oFolder As Folder, olNS As Outlook.Namespace, oMailItem As MailItem, obj, nCtr As Integer, sTemp As String
Dim fso, txt, oRec As Recipient
Set fso = CreateObject("Scripting.FileSystemObject")

rest remains the same.
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 1600 total points
ID: 34259092
In the snippet, in there are som elines that haven't come accross correctly with cut and paste so retry here

Note it's nothing at all to do with scripting runtime library.

Chris
Sub getrecip()
Dim dict As Object
Dim mai As Object
Dim recip As Recipient
Dim str As String
Dim outfile As Object
Dim arr As Variant
Dim itm As Variant

   Set dict = CreateObject("scripting.dictionary")
   dict.CompareMode = vbTextCompare
   For Each mai In Application.Session.GetDefaultFolder(olFolderSentMail).items
       If mai.Class = olMail Then
           Debug.Print mai.subject
           On Error GoTo getnext
           For Each recip In mai.Recipients
               str = getSMTPaddress(recip.Address)
               If str <> "" And Not dict.Exists(str) Then dict.Add str, str
           Next
getnext:
           Set mai = Nothing
       End If
   Next
   Set outfile = getTextFile("c:\deleteme\", "gashisme.txt")
   arr = dict.items
   For Each itm In arr
       outfile.WriteLine itm
   Next
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 callif 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

Function getTextFile(outputPath As String, outputFileName As String) As Object
'    Set outputfile = getTextFile("c:\deleteme22\sub2\temp", "gashisme.txt")
'    outputfile.WriteLine "Something for me"
'    outputfile.Close
Dim outputfile As Object
Dim fso As Object
Dim pathComponents() As String
Dim pathComponent As Integer
Dim fldr As String

   If Right(outputPath, 1) = "\" Then outputPath = Left(outputPath, Len(outputPath) - 1)
   Set fso = CreateObject("Scripting.FileSystemObject")
   pathComponents = Split(outputPath, "\")
   For pathComponent = 0 To UBound(pathComponents)
       If pathComponent <> 0 Then
           fldr = fldr & "\"
       End If
       fldr = fldr & pathComponents(pathComponent)
       If Not fso.FolderExists(fldr) Then
           fso.CreateFolder fldr
       End If
   Next
   Set outputfile = fso.CreateTextFile(outputPath & "\" & outputFileName, True)
   outputfile.WriteLine "File Initialised on " & Format(Date, "dd mmm yyyy") & " at " & Format(Time(), "hh:mm")
   outputfile.WriteLine "========================================"
   outputfile.WriteLine ""
   Set getTextFile = outputfile

End Function

Open in new window

0
 
LVL 2

Author Comment

by:alexr54
ID: 34259107
Thank you. I have never used macros for outlook before, so i am not sure what is refferenced or not.
0
 
LVL 2

Author Closing Comment

by:alexr54
ID: 34259216
Awarded 400 points for the answer which i am using. Awarded 100 for the helpful tips.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34259789
Ah, well for anyone looking at the thread you should know that your request was to replace exchange addresses with SMTP addresses.  The post from gbanik will not do this ... you were only going to get pukka emails from the external mail addresses, internal ones were going to be the exchange addresses - i.e. all the gibberish you wanted to avoid.

That said, i'm glad to have helped.

Chris
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

With its various features, Office 365 can not only help you with your day-to-day business tasks, it can also do wonders for your marketing campaign.
Want to know how to use Exchange Server Eseutil command? Go through this article as it gives you the know-how.
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…
Suggested Courses

610 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