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!
 

Some videos you may like

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,763
Office Version
365
Platform
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:

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,106,460
Messages
5,511,508
Members
408,853
Latest member
JoshuaHudsonpTi45

This Week's Hot Topics

  • Turn fraction around
    Hello I need to turn a fraction around, for example I have 1/3 but I need to present as 3/1
  • TIme Clock record reformatting to ???
    Hello All, I'd like some help formatting this (Tbl-A)(Loaded via Power Query) [ATTACH type="full" width="511px" alt="PQdata.png"]22252[/ATTACH]...
  • TextBox Match
    hi, I am having a few issues with my code below, what I need it to do is when they enter a value in textbox8 (QTY) either 1,2 or 3 the 3 textboxes...
  • Using Large function based on Multiple Criteria
    Hello, I can't seem to get a Large formula to work based on two criteria's. I can easily get a oldest value based one value, but I'm struggling...
  • Can you check my code please
    Hi, Im going round in circles with a Compil Error End With Without With Here is the code [CODE=rich] Private Sub...
  • Combining 2 pivot tables into 1 chart
    Hello everyone, My question sounds simple but I do not know the answer. I have 2 pivot tables and 2 charts that go with this. However I want to...
Top