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

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,295
Office Version
  1. 365
Platform
  1. Windows
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.:)
 

Smitty

Legend
Joined
May 15, 2003
Messages
29,536
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:

Watch MrExcel Video

Forum statistics

Threads
1,132,743
Messages
5,655,035
Members
418,171
Latest member
ramiroayala

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
Top