Results 1 to 4 of 4
  1. #1
    Join Date
    May 2014
    Posts
    14

    Wink Unanswered: Triggering an Automatic Email Response based on Dates Generated By Query

    I would like to create a query that would do the following give me all dates that occurred within the last six months triggered by a date entered into table which when reached it would trigger an email being sent. To explain more detail I am working on a funeral home database. (Which seems like a never ending but I am learning so much so I want to keep building it). Once I enter the date of death field name (DOD) I want query to all deaths that happen prior to past six months from current date. Which would trigger and email that would notify me to send a follow up letter for family. How would I achieve this any ideas?
    I have created a query using Names and DOD with the following Criteria <Date()-180 and it does generate the desired clients. However, I have no clue how to make this query trigger email and once email is sent to remove that client next time query is run. Would love to create an executable file that would generate each time database is loaded.
    christyxo posted this, however, I am not sure how to make this work or how to implement it.

    Private Sub Cmd_Reminder_Click()

    Dim MyDimListIndex
    Dim MyDimSubject

    Dim MyDimMessage
    Dim MyDimSignature
    Dim SQLDelEvaluation

    MyDimListIndex = 1

    MyDimSubject = "ERC Reminder"

    Do Until Me.List01.ListCount = 1

    Me.List01 = Me.List01.ItemData(1)

    '
    ' This is the email that you want to send.

    MyDimMessage = vbCrLf

    MyDimMessage = MyDimMessage & "Dear " & Me.List01.Column(9) & ", " _
    & vbCrLf _
    & vbCrLf

    MyDimMessage = MyDimMessage & "The approval status of your study titled;" _
    & vbCrLf _
    & vbCrLf _
    & Me.List01.Column(3) _
    & vbCrLf _
    & vbCrLf _
    & "...is approaching it's expiration date." _
    & vbCrLf _
    & vbCrLf

    MyDimMessage = MyDimMessage & "Put the rest of your message here..." _
    & vbCrLf _
    & vbCrLf _

    '
    ' This will be the signature displayed at the end of your email
    '

    MyDimSignature = "Yours Sincerly," _
    & vbCrLf _
    & vbCrLf _
    & "Your Name Here" _
    & vbCrLf _
    & "Your Contact Number Here"

    '
    ' Send the message
    ' Change the final arguement to FALSE if you want to send the emails automatically, without checking them
    '

    DoCmd.SendObject , , , Me.List01.Column(10), , , MyDimSubject, MyDimMessage & MyDimSignature, True

    MyDimListIndex = MyDimListIndex + 1

    ' Apend Table

    DoCmd.SetWarnings False
    DoCmd****nSQL "UPDATE Project SET Project.ReminderDate = Now() WHERE (((Project.ProjectId)=" & Me.List01.Column(0) & "));"
    DoCmd.SetWarnings True

    Me.List01.Requery

    Loop

    End Sub


    Once again I am a novice and I want to thank everyone in advance for all their help, I could have not did any of this without this forum.
    Thanks Bill

  2. #2
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    495
    Provided Answers: 24
    Is it to send the entire list to 1 email, or each 1 record goes to the 1 person email on that record ?

  3. #3
    Join Date
    May 2014
    Posts
    14

    Follow Up

    It is to send email to one staff person to remind her once the 6 months has been reached based upon date of death (DOD). Than that staff member will send out need follow up letter to family.

  4. #4
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    495
    Provided Answers: 24
    Create a query that has the list of DOD for the day. (or when)
    docmd.TransferSpreadsheet 'to a file
    use it below:

    Click Send button to run the email code:
    Code:
    Public Function EmailOutlook(ByVal pvTo, ByVal pvSubj, ByVal pvBody, ByVal pvFile) As Boolean
    Dim oApp As Outlook.Application
    Dim oMail As Outlook.MailItem
    
    On Error GoTo ErrMail
    
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(olMailItem)
    
    With oMail
        .To = pvTo
        .Subject = pvSubj
        If Not IsNull(pvBody) Then .Body = pvBody
        .Attachments.Add pvFile, olByValue, 1, "attached file"
        
        .Send
    End With
    
    EmailOut = True
    Set oMail = Nothing
    Set oApp = Nothing
    Exit Function
    
    ErrMail:
    MsgBox Err.Description, vbCritical, Err
    Resume Next
    Resume
    End Function

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •