Automating Email

[js061256]

What I'm trying to do is to automate an Outlook email response system (using linked folders) that automatically returns to the sender a data comparison check on an attached Excel spreadsheet. The first part that periodically checks the folder table, compares the data from the email body and exports the attachment works fine.

I'm currently using a form to run the On Timer event and display the return (original sender) email address and customized message. My problems include getting the form data on to the reply email, refreshing the form, code not finding the fields in the form, etc.

Besides poor coding, I think my overall methodology is ham-handed. Please, can anyone critique the code and/or offer a better way to approach this situation?

Private Sub Form_Timer()

Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim SendTo As String '-- Address for SendObject
Dim RBdy As String '-- E-mail text
Dim RSub As String '-- Subject line of e-mail

Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)


If DCount("Created", "Instant IPP Status Checks", "") > 0 Then

DoCmd.RefreshRecord
DoCmd.OpenQuery "OldestContentsq", acViewNormal, acEdit
DoCmd.GoToControl "Contents"
DoCmd.RunCommand acCmdCopy
DoCmd.Close acQuery, "OldestContentsq"
DoCmd.OpenForm "CheckerSubf", acNormal, "", "", , acNormal
DoCmd.SetWarnings False
DoCmd.RunCommand acCmdPasteAppend
DoCmd.Close acForm, "CheckerSubf"
DoCmd.SetWarnings False
DoCmd.OutputTo acOutputQuery, "CheckStatusesq", "ExcelWorkbook(*.xlsx)", "G:\XE_ECMs\IPP Sharing Development\Status Exports\Your Instant IPP Check Results.xlsx", False, "", , acExportQualityPrint
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM Checkert"
DoCmd.OpenQuery "AppendIIPPSRq", acViewNormal, acEdit
DoCmd.SetWarnings False
DoCmd.RefreshRecord
Pause (1)

End If

With MailOutLook

SendTo = Me.RTo 'Having trouble getting form fields in the outgoing email.
RBdy = "For code and instructions to automatically create an addressed formatted email, go to:
RSub = Me.RSubject

Pause (1)

.BodyFormat = olFormatRichText
.To = SendTo
''.cc = ""
''.bcc = ""
.Subject = RSub
.HTMLBody = RBdy
.Attachments.Add ("G:\XE_ECMs\IPP Sharing Development\Status Exports\Your Instant IPP Check Results.xlsx")
Pause (1)
.Send
End With

DoCmd.OpenQuery "DeleteIIPPSRq", acViewNormal, acEdit
DoCmd.SetWarnings False
DoCmd.RunCommand acCmdDeleteRecord
DoCmd.Close acQuery, "DeleteIIPPSRq"
DoCmd.SetWarnings True

End Sub

Thanks!