Solved

VB Code To Loop Through Sent Items And Extract Recipients Email Addresses

Posted on 2006-10-24
3
744 Views
Last Modified: 2012-06-27
Hi,
I need a quick way of scanning a users sent items and extracting all the recipient email addresses (as strings) and saving them to a database. I'm not used to VB app programming and am having real trouble finding a way of extracting the recipient email address(es) as a string from a mailitem object. Basically I can't find the right property of the mailitem object - I have tried the recipient (and recipient.addressitem) property but this doesn't work - Run time error '438', Object doesn't support this property or method. I suspect this is because the property is not of a string type and the variable and the email_addresses variable is. I just can't find the property I need in any of the help files! Or don't know how to convert the property to a string. I'm using the following code (I will add in the code to extract and save to the DB later).

Sub HarvestSent()
 Dim myOlApp As Outlook.Application
 Dim SentItems As Outlook.MAPIFolder
 Dim obj As Outlook.MailItem
 Dim email_addresses As String
 Dim i As Integer
 Set myOlApp = CreateObject("Outlook.Application")
 Set SentItems = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
 For i = 1 To SentItems.Items.Count
  If SentItems.Items(i).Class = olMail Then
   Set obj = SentItems.Items.Item(i)
    email_addresses = obj.Recipient            'this is where it fails
  End If
 Next
End Sub

Please help this is doing my head in!!!

Thanks.
0
Comment
Question by:ShinyApples
  • 2
3 Comments
 
LVL 35

Accepted Solution

by:
mvidas earned 500 total points
Comment Utility
Shiny Apples,

Bear in mind, this will likely trigger the outlook security warning.  Consider using the Redemption object instead to avoid it: http://www.dimastr.com/redemption/home.htm

But you need to get the .address of the .recipient

Sub HarvestSent()
 Dim myOlApp As Outlook.Application
 Dim SentItems As Outlook.MAPIFolder
 Dim email_addresses As String
 Dim i As Integer, j As Integer
 Set myOlApp = CreateObject("Outlook.Application")
 Set SentItems = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
 For i = 1 To SentItems.Items.Count
  If TypeName(SentItems.Items(i)) = "MailItem" Then
   For j = 1 To SentItems.Items.Item(i).Recipients.Count
    email_addresses = SentItems.Items.Item(i).Recipients(j).Address
    Debug.Print email_addresses
   Next
  End If
 Next
 Set SentItems = Nothing
 Set myOlApp = Nothing
End Sub

If you want the name of the recipient, use .AddressEntry

Matt
0
 

Author Comment

by:ShinyApples
Comment Utility
Thank you very much matt that worked perfectly. The points are yours!

0
 
LVL 35

Expert Comment

by:mvidas
Comment Utility
Glad to help!
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Get an idea of what you should include in an email disclaimer with these Top 5 email disclaimer tips.
Resolve Outlook connectivity issues after moving mailbox to new Exchange 2016 server
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

728 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

10 Experts available now in Live!

Get 1:1 Help Now