Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Outlook VB for getting email addresses - handy but stopped working ! 2

Status
Not open for further replies.

NWildblood

Technical User
Nov 12, 2007
113
GB
Hi all
I have had this handy bit of code kicking around for ages that simply selects email addresses from all emails in a folder (inbox) and dumps them in an excel file. The only problem is since I moved companies (using an older version of MS Office) the addresses appear as a form of code that is how the server recognises them, but obviously with limited use.

e.g. my own address appears like this

/O=RAILTRACK/OU=EXCHANGE ADMINISTRATIVE GROUP (FYDIBOHF23SPDLT)/CN=RECIPIENTS/CN=NSLATER12

Does anyone have any solutions ?

Thank you in advance !


"No-one got everything done by Friday except Robinson Crusoe...
 
It might help to spot the error if you posted your code or at least a snippet showing how you are retrieving the address.

Offand, I'd guess the MailItem object has some sort of addresses collection and it is just a matter of figuring out how to pull the SMTP address rather than one of exchange's other addresses...
 
Thanks lameid

Here it is:

Sub GetALLEmailAddresses()
Dim objFolder As MAPIFolder
Dim strEmail As String
Dim strEmails As String
Dim objDic As Object
Dim objItem As Object
Dim objFSO As Object
Dim objTF As Object

Set objDic = CreateObject("scripting.dictionary")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objTF = objFSO.createtextfile("C:\emails.csv", 2)
Set objFolder = Application.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
For Each objItem In objFolder.Items
If objItem.Class = olMail Then
strEmail = objItem.SenderEmailAddress
If Not objDic.Exists(strEmail) Then
objTF.writeline strEmail
objDic.Add strEmail, ""
End If
End If
Next
objTF.Close
End Sub




No hay nada como un buitre cabrón como un ojo de cristal.
 
After poking it and looking at objItem.SenderEmailType I can see you are getting the EX e-mail type.. So then I turned to google and found this...

--Not sure what the URL is accomplishing at a glance, investigate a little

If you are willing to jump into access, this looks promising too, ironically I posted there.
thread705-1545105

Seems like you should be able to accomplish it with LDAP as well... ADO should be able to connect to it and then you'd have to dig out the data you want... More searching for the details on those but an option.

Sue Mosher (exchange/outlook guru) posted somewhere about using the Redemtion object model... I suspect this may be easiest but not the cheapest.
 
Also worth a mention, this code obviously worked before because exchange was not being used and therefore all e-mailes where from SMTP addresses.

Although, perhaaps you are only looking for external addresses which should all be SMTP? Conversely, if using internally with exchange, the addresses will likely still send.
 
Thanks for all of this lameid - the gregthatcher link and the access idea both look promising.
Kind Regards
OOS


No hay nada como un buitre cabrón como un ojo de cristal.
 
>Not sure what the URL

It isn't actually a URL. It is the name of a property.
 
Thanks again foir the links. Have just run compile project on the GregThatcher code and am getting User-defined type not identified here:

Dim exchangeUser As exchangeUser


Highlighted in full code below:

Public Sub GetSmtpAddressOfCurrentEmail()
Dim Session As Outlook.NameSpace
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim currentItem As Object
Dim currentMail As MailItem
Dim smtpAddress As String

Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection

'for all items do...
For Each currentItem In Selection
If currentItem.Class = olMail Then
Set currentMail = currentItem
smtpAddress = GetSmtpAddress(currentMail)
MsgBox "SMTP Address is " & smtpAddress
End If
Next

End Sub
Public Function GetSmtpAddress(mail As MailItem)
On Error GoTo On_Error

GetSmtpAddress = ""

Dim Report As String
Dim Session As Outlook.NameSpace
Set Session = Application.Session

If mail.SenderEmailType <> "EX" Then
GetSmtpAddress = mail.SenderEmailAddress
Else
Dim senderEntryID As String
Dim sender As AddressEntry
Dim PR_SENT_REPRESENTING_ENTRYID As String

PR_SENT_REPRESENTING_ENTRYID = "
senderEntryID = mail.PropertyAccessor.BinaryToString( _
mail.PropertyAccessor.GetProperty( _
PR_SENT_REPRESENTING_ENTRYID))

Set sender = Session.GetAddressEntryFromID(senderEntryID)
If sender Is Nothing Then
Exit Function
End If

If sender.AddressEntryUserType = olExchangeUserAddressEntry Or _
sender.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then

Dim exchangeUser As exchangeUser [highlight #EF2929]'PROBLEM ARRISES HERE[/highlight]
Set exchangeUser = sender.GetExchangeUser()

If exchangeUser Is Nothing Then
Exit Function
End If

GetSmtpAddress = exchangeUser.PrimarySmtpAddress
Exit Function
Else
Dim PR_SMTP_ADDRESS
PR_SMTP_ADDRESS = " GetSmtpAddress = sender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
End If


End If


Exiting:
Exit Function
On_Error:
MsgBox "error=" & Err.Number & " " & Err.Description
Resume Exiting

End Function


No hay nada como un buitre cabrón como un ojo de cristal.
 
Typically this means the code requires a reference to something.

Looks like this code is intended to run to Outlook and if I put it in say Access, add an outlook reference and put "outlook." before all the application uses, it compiles (obviously won't run because I need to declare and set an outlook application object).

It is curious that it is written native for outlook but and hits a hiccup (assuming you are using outlook). In anycase, I'd try fixing it to run from any office application and see if it works.
 
Which version of Outlook are you using ?
exchangeUser was added to the Outlook object model for the 2007 version.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Thanks PHV, yes, unfortunately have just moved to a very large organisation that is still running 2003... is there a workaround that you know of ?

No hay nada como un buitre cabrón como un ojo de cristal.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top