Alternative to SendObject to achieve automation

jeudi 12 mars 2015

Hi All,



I have been grappling with this for a little while. I have this piece of code in my access database which currently looks for records which meet a certain criteria (set in mt Report_review_documents) and then emails the individuals within that query a list of their records (as an attached excel file).



It works fine, however its in plain text and I really need to send out the automated emails in html to smarten them up. I understand that the sendObject command wont allow html. Is there another way to achieve what I am trying to do using html in the email?



Hope you can help,



James.



Private Sub Send_Email_Click()



Dim StrSubject As String

Dim StrMsg As String

Dim StrMsg1 As String

Dim TblName As String

Dim SQLStr As String

Dim db As Database 'Will be set to the current database

Dim SQLDirectory As Variant 'SQL statement to get stored directory

Dim rsDirectory As DAO.Recordset 'Holds the stored directory

Dim ArrayPersonName As Variant

Dim count As Integer

Dim n As Integer



On Error GoTo error_handler



StrSubject = "ACTION NEEDED"

StrMsg = "message"

StrMsg1 = "message"

TblName = "Tbl_Report_review_documents_email"



'Turn off warning messages

DoCmd.SetWarnings False



'make table of docs for review

DoCmd.OpenQuery "mt Report_review_documents", acViewNormal, acEdit

'DoCmd.OpenQuery "Review_contact_list", acViewNormal, acEdit



'Load the current database into the variable db

Set db = CurrentDb



'Check for stored file location

SQLDirectory = "SELECT * from [Review_contact_list]"

Set rsDirectory = db.OpenRecordset(SQLDirectory)

rsDirectory.MoveLast

rsDirectory.MoveFirst



count = rsDirectory.RecordCount



'If they exist, set directories to stored value

If rsDirectory.BOF <> True And rsDirectory.EOF <> True Then



ArrayPersonName = rsDirectory.GetRows(rsDirectory.RecordCount)



Else



Exit Sub



End If



'for each entry in the array

For n = 0 To count - 1



'make table with individual's docs

SQLStr = "SELECT [Primary contact], [Doc No], Title, Version, [Published_date], [Review due date], Hyperlink, [Document type], [Owning team], [Feedback]" & _

" INTO Tbl_Report_review_documents_email FROM Tbl_Report_review_documents" & _

" WHERE ((([Primary contact])= '" & ArrayPersonName(0, n) & "'));"





DoCmd.RunSQL (SQLStr)



DoCmd.SendObject acSendTable, TblName, acFormatXLS, ArrayPersonName(0, n), , , StrSubject, StrMsg & StrMsg1, True





resume_next:



Next n





'close the recordset

rsDirectory.Close



'Turn on warning messages

DoCmd.SetWarnings True



MsgBox "Email 30 day reminder operation complete. Do not repeat for at least one week"





Application.SetHiddenAttribute acQuery, "Tbl_Report_review_documents", True

Application.SetHiddenAttribute acQuery, "Tbl_Report_review_documents_email", True

Exit_Send_Email_Click:

Exit Sub



error_handler:



If Err.Number = 2501 Then

'Err.Clear

Resume resume_next

End If

MsgBox Err.Description

Resume Exit_Send_Email_Click



End Sub

Alternative to SendObject to achieve automation

0 commentaires:

Enregistrer un commentaire

Labels