Solved eMailing an ACCESS report in PDF and opening the new OUTLOOK mail in HTML format

HealthyB1

Registered User.
Local time
Today, 16:15
Joined
Jul 21, 2013
Messages
103
I wrote an invoicing system in Access many years ago. I produce an invoice that i then send to Outlook using the default email button in the ribbon of Usoft Access after specified the format as PDF format.
It does this ok and opens the new Outlook mail document (IN PLAIN TEXT Format) with the PDF invoice attached.

My normal Outlook signature is in HTML format and includes a company logo.
When I try to add the signature to the email the logo is omitted as the default document is in Plain Text Format.
If I convert the document to HTML in the initial default document and then add the signature, everything works ok.

I am seeking to automate the conversion of the document to HTML, and adding the signature, using a macro button or VBA
Please note that i have recently upgrades to office 365 and some of the buttons like convert text to HTML are now in different spots or drill downs on the ribbon
Can anyone please point me in a direction where I might find some examples or help in doing this please?

Capture1.PNG
Capture2.PNG
 
save the report, then email via

Code:
dim vDir , vFile
vDir = "c:\temp\
vFile= vDir & "rMyReport.pdf"

  'make pdf
DoCmd.OutputTo acOutputReport, "rMyReport", acFormatPDF, vFile
  'send rpt
send1email "Coyote@acme.com", "your report","here is your report",vFile

then email it :
Code:
Public Function Send1Email(ByVal pvTo, ByVal pvSubj, ByVal pvBody, Optional ByVal pvFile) As Boolean
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem

On Error GoTo ErrMail

'NOTE : YOU MUST HAVE THE OUTLOOK REFERENCE CHECKED IN VBE; Alt-F11, menu,tools, references, Microsoft Outlook XX Object library

Set oApp = GetApplication("Outlook.Application")  'it may be open already so use this
'Set oApp = CreateObject("Outlook.Application")  'not this

Set oMail = oApp.CreateItem(olMailItem)
With oMail
    .To = pvTo
    .Subject = pvSubj
    If Not IsMissing(pvFile) Then .Attachments.Add pvFile, olByValue, 1
   
    .HTMLBody = pvBody
    'If Not IsNull(pvBody) Then .Body = pvBody
   
    .Display True   'show user but dont send yet
    '.Send          'send now
End With

Send1Email = True
endit:
Set oMail = Nothing
Set oApp = Nothing
Exit Function

ErrMail:
MsgBox Err.Description, vbCritical, Err
Resume endit
DoCmd.OutputTo acOutputReport, "rMyReport", acFormatPDF, vFile

End Function

Function GetApplication(className As String) As Object
' function to encapsulate the instantiation of an application object
Dim theApp As Object
On Error Resume Next
Set theApp = GetObject(, className)
If Err.Number <> 0 Then
    MsgBox "Unable to Get" & className & ", attempting to CreateObject"
    Set theApp = CreateObject(className)
End If

If theApp Is Nothing Then
    Err.Raise Err.Number, Err.Source, "Unable to Get or Create the " & className & "!"
    Set GetApplication = Nothing
End If

'MsgBox "Successfully got a handle on Outlook Application, returning to caller"
Set GetApplication = theApp
End Function
 
save the report, then email via

Code:
dim vDir , vFile
vDir = "c:\temp\
vFile= vDir & "rMyReport.pdf"

  'make pdf
DoCmd.OutputTo acOutputReport, "rMyReport", acFormatPDF, vFile
  'send rpt
send1email "Coyote@acme.com", "your report","here is your report",vFile

then email it :
Code:
Public Function Send1Email(ByVal pvTo, ByVal pvSubj, ByVal pvBody, Optional ByVal pvFile) As Boolean
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem

On Error GoTo ErrMail

'NOTE : YOU MUST HAVE THE OUTLOOK REFERENCE CHECKED IN VBE; Alt-F11, menu,tools, references, Microsoft Outlook XX Object library

Set oApp = GetApplication("Outlook.Application")  'it may be open already so use this
'Set oApp = CreateObject("Outlook.Application")  'not this

Set oMail = oApp.CreateItem(olMailItem)
With oMail
    .To = pvTo
    .Subject = pvSubj
    If Not IsMissing(pvFile) Then .Attachments.Add pvFile, olByValue, 1
  
    .HTMLBody = pvBody
    'If Not IsNull(pvBody) Then .Body = pvBody
  
    .Display True   'show user but dont send yet
    '.Send          'send now
End With

Send1Email = True
endit:
Set oMail = Nothing
Set oApp = Nothing
Exit Function

ErrMail:
MsgBox Err.Description, vbCritical, Err
Resume endit
DoCmd.OutputTo acOutputReport, "rMyReport", acFormatPDF, vFile

End Function

Function GetApplication(className As String) As Object
' function to encapsulate the instantiation of an application object
Dim theApp As Object
On Error Resume Next
Set theApp = GetObject(, className)
If Err.Number <> 0 Then
    MsgBox "Unable to Get" & className & ", attempting to CreateObject"
    Set theApp = CreateObject(className)
End If

If theApp Is Nothing Then
    Err.Raise Err.Number, Err.Source, "Unable to Get or Create the " & className & "!"
    Set GetApplication = Nothing
End If

'MsgBox "Successfully got a handle on Outlook Application, returning to caller"
Set GetApplication = theApp
End Function
Hi Ranman,
We have had a severe weather event in my area last Saturday and power is yet to be fully restored. Once I can fire up the PC I shall implement your code. Thanks for the quick response and I shall keep you posted on the outcome. Cheers.
 
Hi Ranman,
We have had a severe weather event in my area last Saturday and power is yet to be fully restored. Once I can fire up the PC I shall implement your code. Thanks for the quick response and I shall keep you posted on the outcome. Cheers.
G'day Ranman,
Your solution works a treat. Thank you ever so much.
Cheers from Adelaide, South Australia.
 

Users who are viewing this thread

Back
Top Bottom