jeran042
Registered User.
- Local time
- Today, 05:08
- Joined
- Jun 26, 2017
- Messages
- 127
I am trying to iterate over the same recordset twice to generate 2 separate emails.
The first will attach a password protected email, and the second will be the password for said email.
The first loop works exactly as desired, its restarting the loop through the recordset that I am having an issue with. I did a search online and was able to find something, but I am not able to get it to work with my module. (as you will see below, I am a novice at best)
Here is what I have:
The first will attach a password protected email, and the second will be the password for said email.
The first loop works exactly as desired, its restarting the loop through the recordset that I am having an issue with. I did a search online and was able to find something, but I am not able to get it to work with my module. (as you will see below, I am a novice at best)
Here is what I have:
Code:
Private Sub Command143_Click()
''Confirm that user want to take this action
If MsgBox("This action will email ALL active department monthly reports, " & vbNewLine & _
"Do you want to continue? ", vbCritical + vbYesNo, " WARNING ") = vbYes Then
'Error handling
'On Error GoTo Error_Handler
'Turn off warnings
DoCmd.SetWarnings False
Dim strSQL As String
Dim rs As DAO.Recordset
Dim iCost As Long
Dim sDepartment As String
Dim myFilePath As String
Dim sMonthlyFileName As String
Dim sEmail As String
Dim sEmailCC As String
Dim appOutLook As Object
Dim MailOutLook As Object
Dim objOutlook As Object
Dim objMailItem As Object
strSQL = "SELECT * FROM qryADP_Distribution"
Set rs = CurrentDb.OpenRecordset(strSQL)
Const olMailItem As Integer = 0
Set objOutlook = CreateObject("Outlook.Application")
If Not rs.BOF And Not rs.EOF Then
rs.MoveFirst
While (Not rs.EOF)
'Set Loop Variables
sDepartment = rs.Fields("DEPARTMENT")
myFilePath = "Y:\Budget process information\2020 Financial Activities\2021 Plan\Salary\zDistribution Salary Template\"
sMonthlyFileName = myFilePath & rs.Fields("DEPARTMENT") & "_2021_Salary_Plan.xlsx"
sEmail = rs.Fields("ADP_EMAIL")
sEmailCC = Nz(rs.Fields("ADP_EMAIL_CC"))
iCost = Left(rs.Fields("DEPARTMENT"), InStr(rs.Fields("DEPARTMENT"), " ") - 1)
'############################################################################
' Test Variables - Uncomment to see variables
' Debug.Print sDepartment
' Debug.Print rs.Fields("DEPARTMENT") & "_2021_Salary_Plan.xlsx"
' Debug.Print sMonthlyFileName
' Debug.Print iCost
' Debug.Print sEmail
' Debug.Print sEmailCC
' Debug.Print vbCr & vbCr
'############################################################################
'Email Generation
'This email will be the initial correspondence
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.To = sEmail
.cc = sEmailCC
.bcc = "joseph.rinaldi@kofc.org"
.SUBJECT = "2021 Salary Template - Due no later than October 28th"
.Body = "COPY EMAIL HERE!!"
.ATTACHMENTS.Add (sMonthlyFileName)
'.ATTACHMENTS.Add (sDetailFileName)
' '.send
.display
End With
Debug.Print rs.Fields("DEPARTMENT") & "_2021_Salary_Plan.xlsx"
rs.MoveNext
Wend
End If
'################################################################
' THIS IS THE PART I NEED ASSISTANCE WITH'
' Restart the loop
rs.MoveFirst
If Not rs.BOF And Not rs.EOF Then
rs.MoveFirst
While (Not rs.EOF)
'Email Generation
'This email will be the password email correspondence
With MailOutLook
.To = sEmail
.cc = sEmailCC
.bcc = "joseph.rinaldi@kofc.org"
.SUBJECT = "2021 Salary Template - Due no later than October 28th"
.Body = Trim(iCost) & "*abcd"
'.ATTACHMENTS.Add (sMonthlyFileName)
'.ATTACHMENTS.Add (sDetailFileName)
' '.send
.display
End With
rs.MoveNext
Wend
End If
rs.Close
Set rs = Nothing
'################################################################
'
'Confirmation
MsgBox "Success! That's some good work, " & vbNewLine _
& "Your emails have been sent to the corresponding departments! ", vbInformation, "GREAT JOB"
Else
MsgBox " Check you Later!", vbInformation, "WHY YOU NO SAY YES?"
End If
Error_Handler_Exit:
Exit Sub
Error_Handler:
Select Case Err.NUMBER
Case 94
Err.Clear
MsgBox "No file matching " & sMonthlyFileName & " found." & vbCrLf & _
"Processing terminated."
Resume Error_Handler_Exit
Case Else
MsgBox "Error No. " & Err.NUMBER & vbCrLf & "Description: " & Err.DESCRIPTION, vbExclamation, "Database Error"
Err.Clear
Resume Error_Handler_Exit
End Select
End Sub