Looper! (1 Viewer)

alexfwalker81

Member
Local time
Today, 04:57
Joined
Feb 26, 2016
Messages
93
How can I adjust this code to loop through each row in a query and send an email for each row?

Code:
Public Function SendEmail()

    
    Dim rsID As DAO.Recordset
    Dim rsDT As DAO.Recordset
    Dim rsDR As DAO.Recordset
    Dim rsCD As DAO.Recordset
    Dim rsCN As DAO.Recordset
    Dim rsPN As DAO.Recordset
    Dim rsPR As DAO.Recordset
    Dim rsAD As DAO.Recordset
    Dim rsCM As DAO.Recordset
    
    Dim db As DAO.Database
    Dim mail    As CDO.MESSAGE
    Dim config  As CDO.Configuration
    Dim latest_entry_ID As String
    Dim latest_entry_DT As String
    Dim latest_entry_DR As String
    Dim latest_entry_CD As String
    Dim latest_entry_CN As String
    Dim latest_entry_PN As String
    Dim latest_entry_PR As String
    Dim latest_entry_AD As String
    Dim latest_entry_CM As String
    
    latest_entry_ID = "SELECT qry_latest_entry.[ID] FROM qry_latest_entry"
    latest_entry_DT = "SELECT qry_latest_entry.[DepositType] FROM qry_latest_entry"
    latest_entry_DR = "SELECT qry_latest_entry.[DateReceived] FROM qry_latest_entry"
    latest_entry_CD = "SELECT qry_latest_entry.[ChequeDate] FROM qry_latest_entry"
    latest_entry_CN = "SELECT qry_latest_entry.[ChequeNumber] FROM qry_latest_entry"
    latest_entry_PN = "SELECT qry_latest_entry.[PayeeName] FROM qry_latest_entry"
    latest_entry_PR = "SELECT qry_latest_entry.[PayeeReference] FROM qry_latest_entry"
    latest_entry_AD = "SELECT qry_latest_entry.[AmountDeposited] FROM qry_latest_entry"
    latest_entry_CM = "SELECT qry_latest_entry.[Comments] FROM qry_latest_entry"
    
    Set db = CurrentDb
    Set rsID = db.OpenRecordset(latest_entry_ID)
    Set rsDT = db.OpenRecordset(latest_entry_DT)
    Set rsDR = db.OpenRecordset(latest_entry_DR)
    Set rsCD = db.OpenRecordset(latest_entry_CD)
    Set rsCN = db.OpenRecordset(latest_entry_CN)
    Set rsPN = db.OpenRecordset(latest_entry_PN)
    Set rsPR = db.OpenRecordset(latest_entry_PR)
    Set rsAD = db.OpenRecordset(latest_entry_AD)
    Set rsCM = db.OpenRecordset(latest_entry_CM)
    
    Set mail = CreateObject("CDO.Message")
    Set config = CreateObject("CDO.Configuration")
    
    config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
    config.Fields(cdoSMTPServer).Value = "10.0.0.102"
    config.Fields(cdoSMTPServerPort).Value = 25
    config.Fields.Update
    
    Set mail.Configuration = config
    
    If DCount("[ID]", "qry_latest_entry_is_cheque") = 0 Then
        
    With mail
        .To = "blah"
       
        .From = "blah"
        .Subject = "BACS Received from " & rsPN![PayeeName] & " - " & rsPR![PayeeReference] & " - " & rsAD![AmountDeposited]
        
        
        .TextBody = "Deposit Receipt ID: " & rsID![ID] & vbCrLf & "Deposit Type: " & rsDT![DepositType] & vbCrLf & "Date Received: " & rsDR![DateReceived] & vbCrLf & "Payee Name: " & rsPN![PayeeName] & vbCrLf & "Payee Reference: " & rsPR![PayeeReference] & vbCrLf & "Amount Deposited: " & rsAD![AmountDeposited] & vbCrLf & "Comments: " & rsCM![Comments]
               
        
        .Send
    End With
    
    Else
    
    With mail
        .To = "blah"
       
        .From = "blah"
        .Subject = "Cheque Received from " & rsPN![PayeeName] & " - " & rsPR![PayeeReference] & " - " & rsAD![AmountDeposited]
        
        
        .TextBody = "Deposit Receipt ID: " & rsID![ID] & vbCrLf & "Deposit Type: " & rsDT![DepositType] & vbCrLf & "Date Received: " & rsDR![DateReceived] & vbCrLf & "Date on Cheque: " & rsCD![ChequeDate] & vbCrLf & "Cheque Number" & rsCN![ChequeNumber] & vbCrLf & "Payee Name: " & rsPN![PayeeName] & vbCrLf & "Payee Reference: " & rsPR![PayeeReference] & vbCrLf & "Amount Deposited: " & rsAD![AmountDeposited] & vbCrLf & "Comments: " & rsCM![Comments]
               
        
        .Send
    End With

    End If
    
    Set config = Nothing
    Set mail = Nothing
    
    
    
  

End Function
 

alexfwalker81

Member
Local time
Today, 04:57
Joined
Feb 26, 2016
Messages
93

Minty

AWF VIP
Local time
Today, 12:57
Joined
Jul 26, 2013
Messages
10,366
Nope, you have created a query / recordset for each field in your query qry_latest_entry. You don't need that.

Set rs = CurrentDb.open Recordset "qry_latest_entry"

Then simply refer to the fields in the recordset as per

rs.Fields("ID")

So this will remove all you different recordsets. Then

Code:
While Not rs.EOF
'    Do your email stuff here 

    rs.movenext
Wend
 

alexfwalker81

Member
Local time
Today, 04:57
Joined
Feb 26, 2016
Messages
93
Like this?

Code:
Public Function SendEmail()

  
    Dim rsID As DAO.Recordset
    Dim rsDT As DAO.Recordset
    Dim rsDR As DAO.Recordset
    Dim rsCD As DAO.Recordset
    Dim rsCN As DAO.Recordset
    Dim rsPN As DAO.Recordset
    Dim rsPR As DAO.Recordset
    Dim rsAD As DAO.Recordset
    Dim rsCM As DAO.Recordset
  
    Dim db As DAO.Database
    Dim mail    As CDO.MESSAGE
    Dim config  As CDO.Configuration
    Dim latest_entry_ID As String
    Dim latest_entry_DT As String
    Dim latest_entry_DR As String
    Dim latest_entry_CD As String
    Dim latest_entry_CN As String
    Dim latest_entry_PN As String
    Dim latest_entry_PR As String
    Dim latest_entry_AD As String
    Dim latest_entry_CM As String
  
    latest_entry_ID = "SELECT qry_latest_entry.[ID] FROM qry_latest_entry"
    latest_entry_DT = "SELECT qry_latest_entry.[DepositType] FROM qry_latest_entry"
    latest_entry_DR = "SELECT qry_latest_entry.[DateReceived] FROM qry_latest_entry"
    latest_entry_CD = "SELECT qry_latest_entry.[ChequeDate] FROM qry_latest_entry"
    latest_entry_CN = "SELECT qry_latest_entry.[ChequeNumber] FROM qry_latest_entry"
    latest_entry_PN = "SELECT qry_latest_entry.[PayeeName] FROM qry_latest_entry"
    latest_entry_PR = "SELECT qry_latest_entry.[PayeeReference] FROM qry_latest_entry"
    latest_entry_AD = "SELECT qry_latest_entry.[AmountDeposited] FROM qry_latest_entry"
    latest_entry_CM = "SELECT qry_latest_entry.[Comments] FROM qry_latest_entry"
  
    Set db = CurrentDb
    Set rs = CurrentDb.OpenRecordset "qry_latest_entry"
  
    Set mail = CreateObject("CDO.Message")
    Set config = CreateObject("CDO.Configuration")
  
    config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
    config.Fields(cdoSMTPServer).Value = "10.0.0.102"
    config.Fields(cdoSMTPServerPort).Value = 25
    config.Fields.Update
  
    Set mail.Configuration = config
  
    If DCount("[ID]", "qry_latest_entry_is_cheque") = 0 Then
      
    With mail
        .To = "blah"
     
        .From = "blah"
        .Subject = "BACS Received from " & rs.Fields("PayeeName") & " - " & rs.Fields("PayeeReference") & " - " & rs.Fields("AmountDeposited")
      
      
        .TextBody = "Deposit Receipt ID: " & rs.Fields("ID") & vbCrLf & "Deposit Type: " & rs.Fields("DepositType") & vbCrLf & "Date Received: " & rs.Fields("DateReceived") & vbCrLf & "Payee Name: " & rs.Fields("PayeeName") & vbCrLf & "Payee Reference: " & rs.Fields("PayeeReference") & vbCrLf & "Amount Deposited: " & rs.Fields("AmountDeposited") & vbCrLf & "Comments: " & rs.Fields("Comments")
             
      
        .Send
    End With
  
    Else
  
    With mail
        .To = "blah"
     
        .From = "blah"
        .Subject = "Cheque Received from " & rs.Fields("PayeeName") & " - " & rs.Fields("PayeeReference") & " - " & rs.Fields("AmountDeposited")
      
      
        .TextBody = "Deposit Receipt ID: " & rs.Fields("ID") & vbCrLf & "Deposit Type: " & rs.Fields("DepositType") & vbCrLf & "Date Received: " & rs.Fields("DateReceived") & vbCrLf & "Date on Cheque: " & rs.Fields("ChequeDate") & vbCrLf & "Cheque Number" & rs.Fields("ChequeNumber") & vbCrLf & "Payee Name: " & rs.Fields("PayeeName") & vbCrLf & "Payee Reference: " & rs.Fields("PayeeReference") & vbCrLf & "Amount Deposited: " & rs.Fields("AmountDeposited") & vbCrLf & "Comments: " & rs.Fields("Comments]
             
      
        .Send
    End With

    End If
  
    Set config = Nothing
    Set mail = Nothing
  
  
  


End Function

I must need to get rid of some of the Dim stuff too?
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 07:57
Joined
May 21, 2018
Messages
8,525
Probably something like
C:
Public Function SendEmail()

 
    Dim rs 
    Dim db As DAO.Database
    Dim mail    As CDO.MESSAGE
    Dim config  As CDO.Configuration
    
  
    Set db = CurrentDb
    Set rs = CurrentDb.OpenRecordset "qry_latest_entry"
    Set mail = CreateObject("CDO.Message")
    Set config = CreateObject("CDO.Configuration")
 
    config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
    config.Fields(cdoSMTPServer).Value = "10.0.0.102"
    config.Fields(cdoSMTPServerPort).Value = 25
    config.Fields.Update
 
    Set mail.Configuration = config
 
    If DCount("[ID]", "qry_latest_entry_is_cheque") = 0 Then
      
    With mail
        .To = "blah"
        .From = "blah"
        .Subject = "BACS Received from " & rs.Fields("PayeeName") & " - " & rs.Fields("PayeeReference") & " - " & rs.Fields("AmountDeposited")
        .TextBody = "Deposit Receipt ID: " & rs.Fields("ID") & vbCrLf & "Deposit Type: " & rs.Fields("DepositType") & vbCrLf & "Date Received: " & rs.Fields("DateReceived") & vbCrLf & "Payee Name: " & rs.Fields("PayeeName") & vbCrLf & "Payee Reference: " & rs.Fields("PayeeReference") & vbCrLf & "Amount Deposited: " & rs.Fields("AmountDeposited") & vbCrLf & "Comments: " & rs.Fields("Comments")
        .Send
    End With
    Else
 
    With mail
        .To = "blah"
    
        .From = "blah"
        .Subject = "Cheque Received from " & rs.Fields("PayeeName") & " - " & rs.Fields("PayeeReference") & " - " & rs.Fields("AmountDeposited")
        .TextBody = "Deposit Receipt ID: " & rs.Fields("ID") & vbCrLf & "Deposit Type: " & rs.Fields("DepositType") & vbCrLf & "Date Received: " & rs.Fields("DateReceived") & vbCrLf & "Date on Cheque: " & rs.Fields("ChequeDate") & vbCrLf & "Cheque Number" & rs.Fields("ChequeNumber") & vbCrLf & "Payee Name: " & rs.Fields("PayeeName") & vbCrLf & "Payee Reference: " & rs.Fields("PayeeReference") & vbCrLf & "Amount Deposited: " & rs.Fields("AmountDeposited") & vbCrLf & "Comments: " & rs.Fields("Comments]
         .Send
    End With

    End If

    Set config = Nothing
    Set mail = Nothing
End Function
 

alexfwalker81

Member
Local time
Today, 04:57
Joined
Feb 26, 2016
Messages
93
Probably something like
C:
Public Function SendEmail()


    Dim rs
    Dim db As DAO.Database
    Dim mail    As CDO.MESSAGE
    Dim config  As CDO.Configuration
   
 
    Set db = CurrentDb
    Set rs = CurrentDb.OpenRecordset "qry_latest_entry"
    Set mail = CreateObject("CDO.Message")
    Set config = CreateObject("CDO.Configuration")

    config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
    config.Fields(cdoSMTPServer).Value = "10.0.0.102"
    config.Fields(cdoSMTPServerPort).Value = 25
    config.Fields.Update

    Set mail.Configuration = config

    If DCount("[ID]", "qry_latest_entry_is_cheque") = 0 Then
     
    With mail
        .To = "blah"
        .From = "blah"
        .Subject = "BACS Received from " & rs.Fields("PayeeName") & " - " & rs.Fields("PayeeReference") & " - " & rs.Fields("AmountDeposited")
        .TextBody = "Deposit Receipt ID: " & rs.Fields("ID") & vbCrLf & "Deposit Type: " & rs.Fields("DepositType") & vbCrLf & "Date Received: " & rs.Fields("DateReceived") & vbCrLf & "Payee Name: " & rs.Fields("PayeeName") & vbCrLf & "Payee Reference: " & rs.Fields("PayeeReference") & vbCrLf & "Amount Deposited: " & rs.Fields("AmountDeposited") & vbCrLf & "Comments: " & rs.Fields("Comments")
        .Send
    End With
    Else

    With mail
        .To = "blah"
   
        .From = "blah"
        .Subject = "Cheque Received from " & rs.Fields("PayeeName") & " - " & rs.Fields("PayeeReference") & " - " & rs.Fields("AmountDeposited")
        .TextBody = "Deposit Receipt ID: " & rs.Fields("ID") & vbCrLf & "Deposit Type: " & rs.Fields("DepositType") & vbCrLf & "Date Received: " & rs.Fields("DateReceived") & vbCrLf & "Date on Cheque: " & rs.Fields("ChequeDate") & vbCrLf & "Cheque Number" & rs.Fields("ChequeNumber") & vbCrLf & "Payee Name: " & rs.Fields("PayeeName") & vbCrLf & "Payee Reference: " & rs.Fields("PayeeReference") & vbCrLf & "Amount Deposited: " & rs.Fields("AmountDeposited") & vbCrLf & "Comments: " & rs.Fields("Comments]
         .Send
    End With

    End If

    Set config = Nothing
    Set mail = Nothing
End Function

Just a couple of tweaks to that, but that works perfectly. Certainly less complex than I'd made it!

I'll just work on adding a looper to it next!
 

Minty

AWF VIP
Local time
Today, 12:57
Joined
Jul 26, 2013
Messages
10,366
Try something like this ;
Code:
Public Sub SendEmail()

 
    Dim rs As DAO.Recordset
    
    Dim db As DAO.Database
    Dim mail    As CDO.MESSAGE
    Dim config  As CDO.Configuration
    
    '    Dim latest_entry_ID As String
    '    Dim latest_entry_DT As String
    '    Dim latest_entry_DR As String
    '    Dim latest_entry_CD As String
    '    Dim latest_entry_CN As String
    '    Dim latest_entry_PN As String
    '    Dim latest_entry_PR As String
    '    Dim latest_entry_AD As String
    '    Dim latest_entry_CM As String
    '
    Set db = CurrentDb
    Set rs = CurrentDb.OpenRecordset("qry_latest_entry", dbOpenSnapshot)
    
    Set mail = CreateObject("CDO.Message")
    Set config = CreateObject("CDO.Configuration")
 
    config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
    config.Fields(cdoSMTPServer).Value = "10.0.0.102"
    config.Fields(cdoSMTPServerPort).Value = 25
    config.Fields.Update
 
    Set mail.Configuration = config
    
    Do While Not rs.EOF
        '
        '    If DCount("[ID]", "qry_latest_entry_is_cheque") = 0 Then
        '
        '    With mail
        '        .To = "blah"
        '
        '        .From = "blah"
        '        .Subject = "BACS Received from " & rs.Fields("PayeeName") & " - " & rs.Fields("PayeeReference") & " - " & rs.Fields("AmountDeposited")
        '
        '
        '        .TextBody = "Deposit Receipt ID: " & rs.Fields("ID") & vbCrLf & "Deposit Type: " & rs.Fields("DepositType") & vbCrLf & "Date Received: " & rs.Fields("DateReceived") & vbCrLf & "Payee Name: " & rs.Fields("PayeeName") & vbCrLf & "Payee Reference: " & rs.Fields("PayeeReference") & vbCrLf & "Amount Deposited: " & rs.Fields("AmountDeposited") & vbCrLf & "Comments: " & rs.Fields("Comments")
        '
        '
        '        .Send
        '    End With
        '
        '    Else
 
        With mail
            .To = "blah"
    
            .From = "blah"
            .Subject = "Cheque Received from " & rs.Fields("PayeeName") & " - " & rs.Fields("PayeeReference") & " - " & rs.Fields("AmountDeposited")
      
            .TextBody = "Deposit Receipt ID: " & rs.Fields("ID") & vbCrLf & "Deposit Type: " & rs.Fields("DepositType") & vbCrLf & "Date Received: " & rs.Fields("DateReceived") & vbCrLf & "Date on Cheque: " & rs.Fields("ChequeDate") & vbCrLf & "Cheque Number " & rs.Fields("ChequeNumber") & vbCrLf & "Payee Name: " & rs.Fields("PayeeName") & vbCrLf & _
                "Payee Reference: " & rs.Fields("PayeeReference") & vbCrLf & "Amount Deposited: " & rs.Fields("AmountDeposited") & vbCrLf & "Comments: " & rs.Fields("Comments")
      
            .Send
        End With
    Loop
    '    End If
 
    Set config = Nothing
    Set mail = Nothing
 

End Sub
You'll need to fiddle with the switch between the two mails as I didn't get how that worked.
 

alexfwalker81

Member
Local time
Today, 04:57
Joined
Feb 26, 2016
Messages
93
You'll need to fiddle with the switch between the two mails as I didn't get how that worked.
Tbh, that switch is kind of defunct now anyway, so I'll need to rework that, but at least I know how to do that!
 

alexfwalker81

Member
Local time
Today, 04:57
Joined
Feb 26, 2016
Messages
93
Nope, you have created a query / recordset for each field in your query qry_latest_entry. You don't need that.

Set rs = CurrentDb.open Recordset "qry_latest_entry"

Then simply refer to the fields in the recordset as per

rs.Fields("ID")

So this will remove all you different recordsets. Then

Code:
While Not rs.EOF
'    Do your email stuff here

    rs.movenext
Wend
With a combination of this snippet and the clean up of my code from MajP, this works a treat.
 

Minty

AWF VIP
Local time
Today, 12:57
Joined
Jul 26, 2013
Messages
10,366
Glad you got it working! Good luck
 

Users who are viewing this thread

Top Bottom