This is what I did in a similar situation. I needed to create a database that would automatically queries all records that were added within a certain time period and find out what wholesalers those records belonged to. Then it would send an e-mail notification out to each of those wholesalers including a weekly report of the data that has been inputted.
I have a table that has the wholesalers and thier e-mail addresses. I setup a query that tells me what what wholesalers belong to what records. I put these results in a form and wrapped it into a listbox.
I used the windows scheduler like you did. I then setup a form as the form that pops up when the application opens up. I set a timeer on the form along with a "cancel" button. The timer run for 30 seconds so that if no-one presses the "cancel" button within 30 seconds then my "frmWholesalerAutoReport" opens.
I setup frmWholesalerAutoReport's load even so that it automatically goes through each record in the listbox (the listbox again is a query against the actaul data in the application and the wholesaler report that has the e-mail addresses in it) If there was data entered for that week and if there is a matching wholesaler then a record will appear in the listbox.
It loops through the listbox, finds wholesaler's name, sends out a e-mail and attaches the wholesaler report, using the Wholesaler name as a parameter within that report. Keep in mind that this e-mails out to 10 different people.
Here is some sample code:
Private Sub Form_Open(Cancel As Integer)
RunReport
DoCmd.Close
End Sub
Private Sub RunReport()
Dim Line As Variant
Dim row As Variant
On Error GoTo Err_cmdReport_Click
Dim intcount As Integer
Dim CCemail As String
For row = 1 To lstWholesaler.ListCount - 1
lstWholesaler.Selected(row) = True
lblWholesalerNum.Caption = lstWholesaler.ItemData(row)
lblContact.Caption = lstWholesaler.Column(2, row)
lblEmail.Caption = lstWholesaler.Column(3, row)
lbl2ndEmail.Caption = lstWholesaler.Column(4, row)
lblWholesalerName.Caption = lstWholesaler.Column(1, row)
lbl2ndEmail.Caption = ""
If Len(lstWholesaler.Column(4, row)) > 2 Then
lbl2ndEmail.Caption = lstWholesaler.Column(4, row)
End If
If Len(lstWholesaler.Column(5, row)) > 2 Then
lbl2ndEmail.Caption = lbl2ndEmail.Caption & "; " & lstWholesaler.Column(5, row)
End If
If Len(lstWholesaler.Column(6, row)) > 2 Then
lbl2ndEmail.Caption = lbl2ndEmail.Caption & "; " & lstWholesaler.Column(6, row)
End If
If Len(lstWholesaler.Column(7, row)) > 2 Then
lbl2ndEmail.Caption = lbl2ndEmail.Caption & "; " & lstWholesaler.Column(7, row)
End If
If Len(lstWholesaler.Column(8, row)) > 2 Then
lbl2ndEmail.Caption = lbl2ndEmail.Caption & "; " & lstWholesaler.Column(8, row)
End If
If Len(lstWholesaler.Column(9, row)) > 2 Then
lbl2ndEmail.Caption = lbl2ndEmail.Caption & "; " & lstWholesaler.Column(9, row)
End If
If Len(lstWholesaler.Column(10, row)) > 2 Then
lbl2ndEmail.Caption = lbl2ndEmail.Caption & "; " & lstWholesaler.Column(10, row)
End If
If Len(lstWholesaler.Column(11, row)) > 2 Then
lbl2ndEmail.Caption = lbl2ndEmail.Caption & "; " & lstWholesaler.Column(11, row)
End If
If Len(lstWholesaler.Column(12, row)) > 2 Then
lbl2ndEmail.Caption = lbl2ndEmail.Caption & "; " & lstWholesaler.Column(12, row)
End If
lstCount.Requery
intcount = lstCount.ListCount
If intcount > 0 Then
If Len(lblEmail.Caption) < 1 Then
Else
Dim stDocName As String
DoCmd.SendObject acSendReport, "rptWholesalerReport_Auto", "Rich Text Format", lblEmail.Caption, lbl2ndEmail.Caption, , "Company Name", lblWholesalerName.Caption & " Account Management Team," & vbNewLine & vbNewLine & vbTab & "Please find attacted the listing for the upcoming Account Information for your accounts. If you have questions regarding this report or the detail of the account activity, please contact your Key Account Manager" & vbNewLine & vbNewLine & vbNewLine & vbNewLine & "Thank You!" & vbNewLine & vbNewLine & "National Accounts", False
Else
End If
Next
DoCmd.Close
Exit_cmdReport_Click:
Exit Sub
Err_cmdReport_Click:
MsgBox Err.Description
Resume Exit_cmdReport_Click
End Sub
Bobby Strickland
Solutions Engineer
Strictly Consulting, Inc
http:
'Pleasure in the job puts perfection in the work' -- Aristotle