Using Redemption with Outlook

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I am trying to write a macro with Redemption to bypass the Outlook Security
message. I am trying to get a list of e-mail addresses for anyone with
specific titles. I have the macro working with CDO but the security message
is annoying and repetitive. I'm currently getting a "Type Mismatch" error
and am not sure why.

Following is what I have so far with (based on the CDO macro) and where the
error occurs. Thanks for the help. Any suggestions would be greatly
appreciated...

Sub ExtractEmailAddrs()
Erase vName
Erase vGpBr
Erase vEmail
Erase vTitle

Dim RedSession As MAPI.Session
Dim SafeAdd As Redemption.SafeRecipient
Dim RedAddressLists As Redemption.AddressLists
Dim RedAddressList As Redemption.AddressList
Dim RedAddressEntries As Redemption.AddressEntries
Dim nFileNum As Long

Set RedSession = New MAPI.Session
RedSession.Logon ("Microsoft Outlook")

Set RedAddressLists = RedSession.AddressLists ** ERROR
Set RedAddressList = RedAddressLists("All Users")

Dim RedAddressEntry As Redemption.AddressEntry
Dim RedAddressEntriesMembers As Redemption.AddressEntries
Set RedAddressEntries = RedAddressList.AddressEntries
Dim ECount As Long
Dim X As Long
Dim Y As Long
Dim Z As Integer
ECount = RedAddressEntries.Count
For X = 1 To ECount
On Error Resume Next
If RedAddressEntries(X).Fields(19) = "Branch Manager" _
Or RedAddressEntries(X).Fields(19) = "Assistant Manager" Then
If Err.Number = 0 Then
Z = Z + 1
ReDim Preserve vName(0 To Z)
ReDim Preserve vGpBr(0 To Z)
ReDim Preserve vEmail(0 To Z)
ReDim Preserve vTitle(0 To Z)
vName(Z) = RedAddressEntries(X).Name
vGpBr(Z) = Mid(RedAddressEntries(X).Fields(23), 1, 4)
vEmail(Z) = RedAddressEntries(X).Address
vTitle(Z) = RedAddressEntries(X).Fields(19)
End If
End If
Err.Number = 0
Next X
On Error GoTo 0

Set RedAddressEntriesMembers = Nothing
Set RedAddressEntry = Nothing
Set RedAddressEntries = Nothing
Set RedAddressList = Nothing
Set RedAddressLists = Nothing

RedSession.Logoff
Set RedSession = Nothing

Set xlApp = New Excel.Application
xlApp.Visible = True
xlApp.Workbooks.Add
xlApp.Cells(1, 1) = "Name"
xlApp.Cells(1, 2) = "GpBr"
xlApp.Cells(1, 3) = "Title"
xlApp.Cells(1, 4) = "Email"
For X = 1 To UBound(vName)
With xlApp
.Cells(X + 1, 1) = vName(X)
.Cells(X + 1, 2).NumberFormat = "@"
.Cells(X + 1, 2) = vGpBr(X)
.Cells(X + 1, 3) = vTitle(X)
.ActiveSheet.Hyperlinks.Add Anchor:=.Cells(X + 1, 4), Address:= _
"mailto:" & vEmail(X), TextToDisplay:=vEmail(X)
End With
Next X

End Sub
 
You dim RedAddressLists As Redemption.AddressLists, but you assign it to
RedSession.AddressLists, whcih returns MAPI.AddressLists.
Simply create an instance of the Redemption.AddressLists object:

set RedAddressLists = CreateObject("Redemption.AddressLists")

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
 
Back
Top