VBA Forward Multiple Emails using Control table with Subjects

[shabee99]

Hello,

I am attempting to forward emails, including attachments, based on the subject line. I have multiple subjects and the related email recipients in a control table. My VBA code runs without error, however it only sends the first record's email. I confirmed the one email get sent, but I need the code to move to the next record until end of control table forwarding multiple emails to multiple recipients. My code is below:

Option Compare Database
Option Explicit


Sub ForwardEmailswithaSpecificSubjects()


    Dim objapp As Outlook.Application
    Dim objns As Outlook.NameSpace
    Set objns = Outlook.GetNamespace("MAPI")
           
    Dim objCurrentFolder As Outlook.Folder
    Dim objVariant As Variant
    Dim objForwardMail As MailItem
    Dim i As Long
    Set Outlook.ActiveExplorer.CurrentFolder = objns.GetDefaultFolder(6)
    Set objCurrentFolder = Outlook.ActiveExplorer.CurrentFolder
    
    'Set Items = objns.GetDefaultFolder(olFolderInbox).Parent.Folders("Inbox").Items
    
    Dim myRs As DAO.Recordset
    Dim myRb As DAO.Recordset
    Set myRs = CurrentDb().OpenRecordset("Email_List_Test")
    Set myRb = CurrentDb().OpenRecordset("bodytext")


   
    For i = objCurrentFolder.Parent.Folders("Inbox").Items.Count To 1 Step -1
        If TypeOf objCurrentFolder.Items.Item(i) Is MailItem Then
           Set objVariant = objCurrentFolder.Parent.Folders("Inbox").Items.Item(i)


                Set objForwardMail = objVariant.Forward
                         
               'change the recipient email address as per your needs
                   'Use ; to connect several recipients
                If myRs.RecordCount > 0 Then
                myRs.MoveFirst
                If objVariant.Subject = myRs![lookup_Subject] Then
                With objForwardMail
                   .To = myRs![Email_Distribution_list]
                   .Subject = "Securemail: " + .Subject
                   .Body = myRb![bodyofemail]
                   .Send
                myRs.MoveNext
                End With
                End If
                End If
             
            End If
        
    Next i
   
    
End Sub

[June7]

What is content of [Email_Distribution_list] field? Is this a comma or semi-colon separated string of multiple addresses?

Tested code and it works.

Have you step debugged?

[shabee99]

June - Yes, the code works. However my control table (Email_List_TEST), which has two fields (Lookup_Subject & Email_Distribution_List) has 180 records/line items looking for different subjects to forward to different recipients. I am not getting any errors, it just looks at the first record in the control table and the email gets forwarded BUT I need it to loop through the 179 other records and perform the same function (looping through the control table) for each record.

[pbaldy]

You're not looping the recordset, which would look like:

Do While Not myRs.EOF
  'perform your process here
  myRs.MoveNext
Loop

[June7]

Did not answer my first 2 questions.