Redemption E-Mail

Smitty

Legend
Joined
May 15, 2003
Messages
29,536
I have a strange issue I can't quite figure out (as usual). I'm using the following Redemption code to send an e-mail from Access without the security prompt:

Code:
Sub RedemptionEMail()
    Dim SafeItem As Object
    Dim objOutlook As Object
    Dim objNS As Object
    Dim olMailItem
    Dim objOutlookMsg As Object
    Dim strSubject As String
    Dim strbody As String
    Dim DB As Database
    Dim rst As Recordset
    Dim strEMailAddress As String
        
        Set DB = CurrentDb
        strEMailAddress = "SELECT tbl_REF_EmailAddresses.txt_EMail, tbl_REF_EmailAddresses.cb_MailYesNo " & vbCrLf & _
            "FROM tbl_REF_EmailAddresses " & vbCrLf & _
            "WHERE (((tbl_REF_EmailAddresses.cb_MailYesNo)=Yes)) " & vbCrLf & _
            "ORDER BY tbl_REF_EmailAddresses.txt_EMail;"
        Set rst = DB.OpenRecordset(strEMailAddress)
        
        Set SafeItem = CreateObject("Redemption.SafeMailItem")
        ' create the Outlook session
        Set objOutlook = CreateObject("Outlook.Application")
        Set objNS = objOutlook.GetNamespace("MAPI")
        objNS.Logon
    
        ' create the Message
        Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
        SafeItem.Item = objOutlookMsg
    
        strSubject = "Foo"
        strbody = "foo2"
        rst.MoveFirst
        
       Do Until rst.EOF
            strEMailAddress = rst![txt_EMail]
            MsgBox strEMailAddress
                With SafeItem
                    .Recipients.Add strEMailAddress
                    .Subject = strSubject
                    .Body = strbody
                    .Display
                    '.Save
                    '.Send
                End With
            rst.MoveNext
        Loop
        
    Set rst = Nothing
    Set DB = Nothing
        
    Set objOutlookMsg = Nothing
    Set objNS = Nothing
    Set objOutlook = Nothing
    Set SafeItem = Nothing
End Sub

I have 2 test e-mail addresses in my e-mail table. Now here's what's weird: MsgBox strEMailAddress will iterate through the addresses and return both, but .Recipients.Add strEMailAddress creates two e-mails, as it should, but it only uses the first e-mail address, not the second. I don't see whay the MsgBox would iterate, but not recipients?

Thanks!
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Smitty

I'm no expert on Redemption, or Outlook VBA for that, but isn't Recipients a collection.

So, and this could be totally wrong, you are adding to this collection on each iteration and perhaps when you create the message Outlook
is only using/displaying the 1st item in the collection, ie the first email address?

Just an idea.:)
 
Upvote 0
That's an idea - I'll see if I can create a new Outlook object on each iteration.

EDIT:

This did it:

Code:
                '   Loop through e-mail addresses & Send Messages
                    rst1.MoveFirst
                        Do Until rst1.EOF
                        
                        '   Set Redemption
                            Set SafeItem = CreateObject("Redemption.SafeMailItem")
                        '   Create the Outlook session
                            Set objOutlook = CreateObject("Outlook.Application")
                            Set objNS = objOutlook.GetNamespace("MAPI")
                            objNS.Logon
                        
                        '   Create the Outlook Message
                            Set objOutlookMsg = objOutlook.createitem(olMailItem)
                            SafeItem.Item = objOutlookMsg
                        
                        '   Assign Recipient
                            strEMailAddress = rst1![txt_EMail]
                            'MsgBox strEMailAddress
                            '   Build & Send Message
                                With SafeItem
                                    .Recipients.Add strEMailAddress
                                    .Subject = strSubject
                                    .Body = strbody
                                    '.Display
                                    '.Save
                                    On Error Resume Next
                                    .Send
                                End With
                                Set SafeItem = Nothing
                                Set objOutlookMsg = Nothing
                                Set objNS = Nothing
                            rst1.MoveNext
                        Loop

Thanks again!
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,530
Messages
6,114,163
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top