S
Steven M. Britton
How do I call a module in VBA code in an onclick event.
Here is the Module:
Option Compare Database
Option Explicit
Sub SendEmails(Cancel As Integer)
Set db = CurrentDb()
Set rec = db.OpenRecordset("tblUPSEmail")
If rec.RecordCount > 0 Then
With rec
.MoveFirst
UPS: Do Until .EOF
DoCmd.SendObject acSendNoObject, , ,
rec.BILLEMAIL, , , "UPS Ground Email", _
"Dear " & rec.FULLNAME & ":" & vbCrLf & "Your order " &
rec.Order_ID & " shipped, ok." _
, False
.MoveNext
Loop
End With
End If
Set rec = db.OpenRecordset("tbl2_3DayEmail")
If rec.RecordCount > 0 Then
With rec
.MoveFirst
Priority: Do Until .EOF
DoCmd.SendObject acSendNoObject, , , rec.BILLEMAIL, , , "2-
3 Day Priority Email", _
"Dear " & rec.FULLNAME & ":" & vbCrLf & "Your order " &
rec.Order_ID & " shipped, ok." _
, False
.MoveNext
Loop
End With
End If
Set db = Nothing
Set rec = Nothing
Exit Sub
End Sub
And I want to put this in at the end of this code:
Private Sub Command231_Click()
On Error GoTo Err_Command231_Click
Dim stDocName, stLinkCriteria, txtToday, str1stEmail,
strUPS, str2_3Day, strInter As String
Dim strUPSTbl, str2_3Tbl, strInterTbl As String
str1stEmail = "qry1stEmail"
strUPS = "qryUPS1stEmailSent"
str2_3Day = "qry2_3Day1stEmailSent"
strInter = "qryInter1stEmailSent"
strUPSTbl = "qryUPSGroundExport"
str2_3Tbl = "qry2_3DayPriorityExport"
strInterTbl = "qryInternationalExport"
DoCmd.Hourglass True
DoCmd.SetWarnings False
' Append new records to Email Table
DoCmd.OpenQuery str1stEmail, acNormal, acEdit
' Makes Table for UPS 1st Email
DoCmd.OpenQuery strUPSTbl, acNormal, acEdit
' Updates the 1st Email as sent
DoCmd.OpenQuery strUPS, acNormal, acEdit
' Makes Table for 2-3 Day Priority 1st Email
DoCmd.OpenQuery str2_3Tbl, acNormal, acEdit
' Updates the 1st Email as sent
DoCmd.OpenQuery str2_3Day, acNormal, acEdit
' Makes Table for International 1st Email
DoCmd.OpenQuery strInterTbl, acNormal, acEdit
' Updates the 1st Email as sent
DoCmd.OpenQuery strInter, acNormal, acEdit
'stDocName = "frmEmails"
'txtToday = Date - 10
'stLinkCriteria = "[OrderDate]=" & "#" & txtToday & "#"
'DoCmd.OpenForm stDocName, acFormDS, , stLinkCriteria
DoCmd.Hourglass False
DoCmd.SetWarnings True
Exit_Command231_Click:
Exit Sub
Err_Command231_Click:
MsgBox Err.Description
DoCmd.Hourglass False
DoCmd.SetWarnings True
Resume Exit_Command231_Click
End Sub
Here is the Module:
Option Compare Database
Option Explicit
Sub SendEmails(Cancel As Integer)
Set db = CurrentDb()
Set rec = db.OpenRecordset("tblUPSEmail")
If rec.RecordCount > 0 Then
With rec
.MoveFirst
UPS: Do Until .EOF
DoCmd.SendObject acSendNoObject, , ,
rec.BILLEMAIL, , , "UPS Ground Email", _
"Dear " & rec.FULLNAME & ":" & vbCrLf & "Your order " &
rec.Order_ID & " shipped, ok." _
, False
.MoveNext
Loop
End With
End If
Set rec = db.OpenRecordset("tbl2_3DayEmail")
If rec.RecordCount > 0 Then
With rec
.MoveFirst
Priority: Do Until .EOF
DoCmd.SendObject acSendNoObject, , , rec.BILLEMAIL, , , "2-
3 Day Priority Email", _
"Dear " & rec.FULLNAME & ":" & vbCrLf & "Your order " &
rec.Order_ID & " shipped, ok." _
, False
.MoveNext
Loop
End With
End If
Set db = Nothing
Set rec = Nothing
Exit Sub
End Sub
And I want to put this in at the end of this code:
Private Sub Command231_Click()
On Error GoTo Err_Command231_Click
Dim stDocName, stLinkCriteria, txtToday, str1stEmail,
strUPS, str2_3Day, strInter As String
Dim strUPSTbl, str2_3Tbl, strInterTbl As String
str1stEmail = "qry1stEmail"
strUPS = "qryUPS1stEmailSent"
str2_3Day = "qry2_3Day1stEmailSent"
strInter = "qryInter1stEmailSent"
strUPSTbl = "qryUPSGroundExport"
str2_3Tbl = "qry2_3DayPriorityExport"
strInterTbl = "qryInternationalExport"
DoCmd.Hourglass True
DoCmd.SetWarnings False
' Append new records to Email Table
DoCmd.OpenQuery str1stEmail, acNormal, acEdit
' Makes Table for UPS 1st Email
DoCmd.OpenQuery strUPSTbl, acNormal, acEdit
' Updates the 1st Email as sent
DoCmd.OpenQuery strUPS, acNormal, acEdit
' Makes Table for 2-3 Day Priority 1st Email
DoCmd.OpenQuery str2_3Tbl, acNormal, acEdit
' Updates the 1st Email as sent
DoCmd.OpenQuery str2_3Day, acNormal, acEdit
' Makes Table for International 1st Email
DoCmd.OpenQuery strInterTbl, acNormal, acEdit
' Updates the 1st Email as sent
DoCmd.OpenQuery strInter, acNormal, acEdit
'stDocName = "frmEmails"
'txtToday = Date - 10
'stLinkCriteria = "[OrderDate]=" & "#" & txtToday & "#"
'DoCmd.OpenForm stDocName, acFormDS, , stLinkCriteria
DoCmd.Hourglass False
DoCmd.SetWarnings True
Exit_Command231_Click:
Exit Sub
Err_Command231_Click:
MsgBox Err.Description
DoCmd.Hourglass False
DoCmd.SetWarnings True
Resume Exit_Command231_Click
End Sub