Can Access generate emails based on record's date (1 Viewer)

[hardhitter06]

Hi All,

Using Access and Outlook 2010.

Not sure if this should have been posted in 'Queries' or 'Modules/VBA' so I apologize if it's in the wrong spot.

I have a database that tracks Contracts for our University. One of the fields it tracks is Expiration Date.

Is there a way to have Access prompt Outlook to send an email to my boss when the contract is a month or within a month from expiring?

I'm assuming when the database is opened it would have to run a query for expiration dates expiring within one month of today's date (which i know how to do).

I just don't know if it's possible to generate an email or some kind of message with those records/contract numbers displayed ?

I should also note my boss is the only one who uses this database so even if the email notice isn't possible, is there a way to show a message of what contracts are expiring soon when he opens the DB?

Thank you.

 

[jdraw]

It would seem that a start up form could be created that would list details of contracts with expiry dates with XX days of today.

I haven't worked with Outlook for a long time, but sending an email with the info should be possible.

See this link for some additional info.

 

[hardhitter06]

Thanks for the quick response. Yeah gathering the information of the records/contracts that are soon to expire isn't the issue.

It's more so figuring out how this can be automatically emailed with an attached report or just the information in the body of an email. Or maybe as simple as if he opens the database and there are records soon to expire, that a prompt says you have XX amount of records about to expire.

Just something to make them stand out without him having to run a report every day or week.

 

[jdraw]

The query should be straight forward and would only involve Access.

Can you post a jpg of the tables and relationships?

 

[hardhitter06]

Jdraw,

I didn't see your link. I think that's a start. I'll follow up on Monday letting you know if I've made any progress.

 

[jdraw]

Good luck.

 

[DemonDNF]

I'm using a modified version of this error handler:
http://www.utteraccess.com/wiki/index.php?title=Image:ErrorHandlingTutorial.zip

It has a feature to auto-send an email via outlook when an error occurs. I would think it has everything you need. I removed that feature because I don't have outlook myself and didn't want to assume users will have it.

Robert

 

[hardhitter06]

How would I add this piece of code to run in an AutoExec?

Private Sub cmdSend_Click()
    
    Dim strReportName As String
    Dim rsMail As New ADODB.Recordset
         
    Dim strMsgText As String
    Dim strSubject As String
    Dim strTo As String
    Dim strCC As String
    Dim strMsgFromDB As String
    
    strSubject = "My Subject Line is here..."
    rsMail.Open "qryMessagesToSend", CurrentProject.Connection, adOpenKeyset, adLockPessimistic
    
    rsMail.MoveFirst

    While Not rsMail.EOF
    
             strTo = rsMail("Clock")
             strMsgFromDB = rsMail("Message")
             
            strMsg = "" ' Reset for every time
            strMsg = "Hello " & rsMail("EmplName")
            
            strMsg = strMsg & vbNewLine & vbNewLine & strMsgFromDB
            
            ' If you wanted to send a Report, as an attachment, change the name from "MS_AccessReportNameHere" to whatever your report is.
            ' You can "filter" the report
            '       say you had one giant query and you only wanted to send *part* of the query to someone
            '       you can "filter" it based on criteria, pulled from the tblMessages table
            
           'change the report filter and save the report
           ' DoCmd.OpenReport "MS_AccessReportNameHere", acViewDesign
           ' Reports![MS_AccessReportNameHere].Filter = "FIELD_NAME_HERE = '" & rsMail("ValueInFieldAsCriteria") & "'"
           ' Reports![MS_AccessReportNameHere].FilterOn = True
           ' DoCmd.Close acReport, "MS_AccessReportNameHere", acSaveYes
             
         
            ' Send it
           'DoCmd.SendObject acSendReport, "MS_AccessReportNameHere", "Snapshot Format (*.snp)", strTo, strCC, , strSubject, strMsgText, False
            
            
            
            
            ' Just sending text - no attachments
            
            ' the "False" is for "Do you want to Edit the email before sending?"
            ' default is "true," so it won't *automatically* send.
            ' set to "false" so that it sends automatically, without additional prompts
            DoCmd.SendObject acSendNoObject, , , strTo, , , strSubject, strMsg, False
            
            
        rsMail.MoveNext
    Wend
    
    rsMail.Close
    Set rsMail = Nothing
    
    MsgBox "Emails Sent"
    
    
End Sub

 

[pr2-eugin]

Change the Sub to Function (make sure you put this in the Standard module and not behind any Form). Then use that in the AutoExec macro's RunCode.

 

[hardhitter06]

PR2,

I went into the Create tab and choose "Module". (As oppose to "Class Module").

I added this function into this module:

Private Function cmdSend()
    
    Dim strReportName As String
    Dim rsMail As New ADODB.Recordset
         
    Dim strMsgText As String
    Dim strSubject As String
    Dim strTo As String
    Dim strCC As String
    Dim strMsgFromDB As String
    
    strSubject = "My Subject Line is here..."
    rsMail.Open "qryMessagesToSend", CurrentProject.Connection, adOpenKeyset, adLockPessimistic
    
    rsMail.MoveFirst

    While Not rsMail.EOF
    
             strTo = rsMail("Clock")
             strMsgFromDB = rsMail("Message")
             
            strMsg = "" ' Reset for every time
            strMsg = "Hello " & rsMail("EmplName")
            
            strMsg = strMsg & vbNewLine & vbNewLine & strMsgFromDB
            
            ' If you wanted to send a Report, as an attachment, change the name from "MS_AccessReportNameHere" to whatever your report is.
            ' You can "filter" the report
            '       say you had one giant query and you only wanted to send *part* of the query to someone
            '       you can "filter" it based on criteria, pulled from the tblMessages table
            
           'change the report filter and save the report
           ' DoCmd.OpenReport "MS_AccessReportNameHere", acViewDesign
           ' Reports![MS_AccessReportNameHere].Filter = "FIELD_NAME_HERE = '" & rsMail("ValueInFieldAsCriteria") & "'"
           ' Reports![MS_AccessReportNameHere].FilterOn = True
           ' DoCmd.Close acReport, "MS_AccessReportNameHere", acSaveYes
             
         
            ' Send it
           'DoCmd.SendObject acSendReport, "MS_AccessReportNameHere", "Snapshot Format (*.snp)", strTo, strCC, , strSubject, strMsgText, False
            
            
            
            
            ' Just sending text - no attachments
            
            ' the "False" is for "Do you want to Edit the email before sending?"
            ' default is "true," so it won't *automatically* send.
            ' set to "false" so that it sends automatically, without additional prompts
            DoCmd.SendObject acSendNoObject, , , strTo, , , strSubject, strMsg, False
            
            
        rsMail.MoveNext
    Wend
    
    rsMail.Close
    Set rsMail = Nothing
    
    MsgBox "Emails Sent"
    
    
End Function

And I saved the module as "Send()".

I went into my AutoExec macro and choose "RunCode" with function name "cmdSend()".

But I am still getting the error that it can't find it. Did I miss something?

 

[pr2-eugin]

Save the module as modSend. The function should be declared as Public not Private.

 

[hardhitter06]

PR2,

That works, thanks! Now I just need to get my function to do what I want.

 

[pr2-eugin]

Glad to help ! So what is that you are trying to do? I can see JD, has helped you. I am being thick here, but I could not understand what exactly you are trying to do. If you could explain one more time, I might be able to help too

 

[hardhitter06]

I am using jDraw's link that had this code within the database.

Within my AutoExec, I have a OpenQuery "qryMessagesToSend" which really is a false name because this query gathers all records that are about to expire in a month and makes a table "tblContractExpiring" (Make Table qry).

Following that is my RunCode "cmdSend()".

Really what I need within my function is for the table "tblContractExpiring" to send its data to my email only.

 

[hardhitter06]

I just saw your response so let me explain in full again.

I have a DB that stores Contracts with expiration dates. My boss wanted to be automatically emailed with the contracts expiring within a month from the "Today's Date" (whatever that day may be).

Now its obvious that an email wouldnt be generated unless the database was opened so I decided that an AutoExec was needed.

I first created a query "qryMessagestoSend" that pulls these records within a month from today's date.

That query is a Make Table query that will make the table tblContractExpiring.

So I then went to my AutoExec -

1. SetWarnings to No

2. DeleteObject tblContractExpiring

3. OpenQuery qryMessengestoSend (which will then make a fresh verision of tblContractExpiring).

4. RunCode cmdSend().

Now the code from JDraw needs to be modified for my needs which im struggling with. I need tblContractExpiring data to be sent to one email (mine for the time being - will be my bosses) everytime the database is opened.

So I need to set a default email.

Second I need the data from that query that made that table to be sent to me...I'm not sure if I can use the qry's data, or the table's data or if I need to create a report. I don't know how to get this table into an email.

That's where i am lol...confused?

 

[pr2-eugin]

So you can loop through the recordset in the tblContractExpiring and then use a VBA method to send email? Much more flexible?

 

[hardhitter06]

Well I would want to send the data returned from 'qryMessagestoSend' which pulls from 'tblDept', 'tblContract', 'tblCategory'.

The fields within this qry are:

Account Number
Vendor
Total Amount
Category
Contract #
Term Begins
Term Ends
Record Date
Comments

Term Ends has the where statement : WHERE (((tblContract.[Term Ends])>=Date() And (tblContract.[Term Ends])<DateAdd("d",+30,Date())))

So when the database was opened, I would want that query to run behind the scenes and email me the data at XXX@XXX.edu.

 

[pr2-eugin]

Okay, I will try to be as informative as I could be. What you need is,

1. Create a DAO.Recordset, that will look into the main table filtering all the records that interest you.

SELECT theFieldsOfInterest FROM theTable
WHERE theExiryDate BETWEEN Date() AND Date()+30;

2. Loop through this recordset, to get the information organized.

Do While Not rsObj.EOF
    someStr = someStr & rsObj.Fields("theFieldsOfInterest")
Loop

3. Then use some code to automate Outlook to send the message for you. Something like.

Public Function cmdSend()
    Dim strReportName As String, strMsgText As String, strSubject As String
    Dim rsMail As New DAO.Recordset
    Dim strTo As String, strCC As String, strMsgFromDB As String
    
    strTo = "xxx.xxx@XXX.xx"
    strSubject = "Here is your Subject line"
    Set rsMail = CurrentDB.OpenRecordset("SELECT tblContract.[Account Number], tblContract.Vendor, tblContract.[Total Amount], " & _
                                         "tblContract.Category, tblContract.[Contract #], tblContract.[Term Begins], tblContract.[Term Ends], " & _
                                         "tblContract.[Record Date], tblContract.Comments FROM tblContract  WHERE (tblContract.[Term Ends] BETWEEN " & _
                                         Format(Date, "\#mm\/dd\/yyyy\#") & " And " & Format(DateAdd("d", 30, Date), "\#mm\/dd\/yyyy\#") & ");")
    
    strMsgFromDB = "<HTML><BODY>Dear Sir/Mam,<BR>Below is the list of all customers, whose contracts are expiring.<BR><TABLE>"
    Do While Not rsMail.EOF
        strMsgFromDB = strMsgFromDB & "<TR>"
        strMsgFromDB = strMsgFromDB & "<TD>" & rsMail.Fields(0) & "</TD>" & _
                                      "<TD>" & rsMail.Fields(1) & "</TD>" & _                                      
                                      "<TD>" & rsMail.Fields(2) & "</TD>" & _                                      
                                      "<TD>" & rsMail.Fields(3) & "</TD>" & _                                      
                                      "<TD>" & rsMail.Fields(4) & "</TD>" & _                                      
                                      "<TD>" & rsMail.Fields(5) & "</TD>" & _                                      
                                      "<TD>" & rsMail.Fields(6) & "</TD>" & _                                      
                                      "<TD>" & rsMail.Fields(7) & "</TD>" & _
                                      "<TD>" & rsMail.Fields(8) & "</TD>" & _
        strMsgFromDB = strMsgFromDB & "</TR>"
    Loop
    strMsgFromDB = "</TABLE></BODY></HTML>"
    
    sendEmail strTo, strSubject, strMsgFromDB
    Set rsMail = Nothing
End Sub

Public Sub sendEmail(eMailStr As String, subjectLine As String, bodyStr As String)
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    
On Error Resume Next
    Set OutApp = New Outlook.Application
    Set OutMail = OutApp.CreateItem(0)
On Error GoTo 0    
    With OutMail
        .Display
        .To = eMailStr
        .Subject = subjectLine
        .HTMLBody = bodyStr & .HTMLBody
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Not tested, but should work ! Could be more robust !