Alternative to SendObject to achieve automation (1 Viewer)

[jlilwall]

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

 

[TimW]

Hi There
this is what I use

   Sub send_Email()

     
          ' email dims
    Dim appOutlook As New Outlook.Application
    Dim msg As Outlook.MailItem

    
       strcc = "Insert CC list addresses here"
'   strTO = "To email addresses go here"
   
    
       'Create new mail message
   Set msg = appOutlook.CreateItem(olMailItem)
   With msg
      .To = strTO
      .Subject = strSubject
      .HTMLBody = strBody
   '  .Body = strBody '' used htmlbody instead :-)
      .cc = strcc
      .Display
      
   End With
        

    End Sub

I use a mixture of rich text enabled fields in tables, vba to concatenate the required string for strBody, sprinkled with HTML for formatting tables etc.

I hope this helps

T

 

[mh123]

You can also try using CDO automation if you don't want to rely on outlook.

See here from quick search as an example;
http://www.access-programmers.co.uk/forums/showthread.php?t=191192

 

[jlilwall]

Thanks for your replies, my main issue is getting access to insert the appropriate contact address and then table into each email, I believe its with this line of code:

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