First, I want to caveat that I have researched this one and have tried a ton of solutions posed here and elsewhere. I apologize if this has been answered before, I swear I have looked and tried, but the main issue I have is that I have the VB skill of a Chimpanzee, and I think the solution requires at least a Bonobo's level of VB skill.
I'm trying to create a VB script in Outlook that will go through my default contacts folders and look at each contacts' .Email1Address and convert the "EX" Email1AddressType to a string and write it to the .User1 property.
The goal is to be able to always export from Outlook the SMTP addresses of my contacts that are stored as "EX" when I add them from the GAL.
I think I am waay off target here, and any help would be appreciated. Thanks very much:
Public Sub User1SMTPAddress()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objContact As Outlook.ContactItem
Dim objItems As Outlook.Items
Dim objContactsFolder As Outlook.MAPIFolder
Dim oExUser As Outlook.ExchangeUser
Dim obj As Object
Dim SMTPEmailAddress As String
Dim MyContactID As String
Dim oPA As Outlook.PropertyAccessor
On Error Resume Next
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts)
Set objItems = objContactsFolder.Items
For Each obj In objItems
If obj.Class = olContact Then
Set objContact = obj
With objContact
Set oPA = objContact.PropertyAccessor
MyContactID = oPA.BinaryToString_(oPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0C190102"))
Set oSender = Globals.objNS.GetAddressEntryFromID(MyContactID)
oExUser = oSender.GetExchangeUser()
SMTPEmailAddress = oExUser.PrimarySmtpAddress
.User1 = SMTPEmailAddress
.Save
End With
End If
Err.Clear
Next
Set objOL = Nothing
Set objNS = Nothing
Set obj = Nothing
Set objContact = Nothing
Set objItems = Nothing
Set objContactsFolder = Nothing
End Sub
