EEDirect
Technical User
- May 19, 2005
- 18
Does anyone know how to take a report and send it via email as a PDF attachment so my customer an open the report in Adobe?
Thanks & Regards,
EEDirect
Thanks & Regards,
EEDirect
Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Function SendOutlookMessage(Recipients As String, Subject As String, Body As String, DisplayMsg As Boolean, Optional CopyRecipients As String, Optional BlindCopyRecipients As String, Optional Importance As Integer = 2, Optional AttachmentPath, Optional AttachmentOptionNumber As Integer)
'Function to create and send an outlook message with more control than sendobject
'separate multiple recipients or CC, or BCC with comma
'importance - 1=low, 2=normal, 3=high
'AttachmentOptionNumber allows additional Attachment based on which Option
'was clicked in order to send the email. - 05-Aug-2003
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.recipient
Dim objOutlookAttach As Outlook.Attachment
Dim txtRecipient As String
Dim stAttachment As String 'Use to store original attachment so that order of attachments for ecp notice will be correct
Dim stattach As String
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Do While InStr(1, Recipients, ",", vbTextCompare) <> 0 'checks for multiple recipients and adds each
txtRecipient = Left(Recipients, InStr(1, Recipients, ",", vbTextCompare) - 1)
Recipients = Trim(Mid(Recipients, Len(txtRecipient) + 2, Len(Recipients)))
Set objOutlookRecip = .Recipients.Add(txtRecipient)
objOutlookRecip.Type = olTo
Loop
Set objOutlookRecip = .Recipients.Add(Trim(Recipients))
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message if existing
If CopyRecipients <> "" Then
Set objOutlookRecip = .Recipients.Add(CopyRecipients)
objOutlookRecip.Type = olCC
End If
' Add the BCC recipient(s) to the message.
If BlindCopyRecipients <> "" Then
Set objOutlookRecip = .Recipients.Add(BlindCopyRecipients)
objOutlookRecip.Type = olBCC
End If
' Set the Subject, Body, and Importance of the message.
.Subject = Subject
.Body = Body & vbCrLf & vbCrLf
Select Case Importance
Case 1
.Importance = olImportanceLow
Case 2
.Importance = olImportanceNormal
Case 3
.Importance = olImportanceHigh
Case Else
.Importance = olImportanceNormal
End Select
' Add attachments to the message.
On Error GoTo SendOutlookMessage_err
If Not IsMissing(AttachmentPath) Then
stAttachment = AttachmentPath
If AttachmentOptionNumber = 1 Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
On Error GoTo SendOutlookMessage_err
AttachmentPath = stAttachment
End If
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
Exit Function
SendOutlookMessage_err:
'If the file isn't found, attach the not found pdf file to
'allow code to continue and user to manually attach file to
'the email
'Change path as appropriate or comment out this section if
'not needing a generic not found attachment
AttachmentPath = "C:\Files\NotFound.pdf"
Resume
End Function
Private Sub SendEmail()
'Send email with attachment
'26 April 2005
Dim stSubject As String
Dim stTo As String
Dim stCc As String
Dim stBody As String
Dim stDate As String
Dim stPathFile As String
Dim intOptionNumber As Integer 'Used for adding an additional attachment. May need to be fixed.
' Use person's name or email id separated by semicolons
stTo = "person name"
stCc = "emailid1; emailid2"
stSubject = "This is the subject for the email"
stBody = "Hello, " & stTo & vbCrLf & vbCrLf & _
"The attached is forwarded for your " & _
"action. Please respond via email by " & Date + 7 & "."
stBody = stBody & _
vbCrLf & vbCrLf & vbCrLf & _
"Regards, " & vbCrLf & vbCrLf & _
" "
vbCrLf
stPathFile = "C:\Temp\filename.pdf"
intOptionNumber = 0
Call SendOutlookMessage(stTo, stSubject, stBody, True, stCc, , , stPathFile, intOptionNumber)
End Sub