Not Attaching PDF

J

jamesmev

Board Regular
Joined
Apr 9, 2015
Messages
233
Office Version
  1. 365
Platform
  1. Windows
i am using the following to copy a sheet -
Place specific Ranges within the body of an email
and attach a pdf of the sheet to the email. However, it will not attach a pdf.
When I run it gives a publishing prompt - creates the email - no PDF.
****************************************
Sub Send_PDF_As_Email()
Dim OlApp As Object
Dim NewMail As Object
Dim TempFilePath As String
Dim TempFileName As String
Dim FileFullPath As String
Set Cell3 = Range("X10") 'email recipient
Sheets("Dashboard").Select
Range("D5").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""X"")"
Range("D6").Select
Sheets("Cona Forms").Select
Range("E229:J229").Select
' file will be saved before
' sending it in email by attaching it.


TempFilePath = Environ$("temp") & ""


' Now append a date and time stamp
' in your pdf file name. Naming convention
' can be changed based on your requirement.


TempFileName = "Equipment Control Request Form" & Format(Now, " dd-mmm-yyyy") & ".pdf"


'Complete path of the file where it is saved
FileFullPath = TempFilePath & TempFileName


'Now Export the Activesshet as PDF with the given File Name and path


With ActiveSheet
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=FileFullPath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
'Now open a new mail


Set OlApp = CreateObject("Outlook.Application")
Set NewMail = OlApp.CreateItem(0)


On Error Resume Next




' -----------------------------------------------------------------------------------------
Call Format_HTML_Table_For_Outlook(strTable, strHdr)
''' Set objMessage = CreateObject("CDO.Message")
Strbody = Strbody & strTable

Strbody = Strbody & "<br><br><br><br><br>" & _
"<font size=1>" & _
"Development Reference:" & "<br>" & _
"Email generated using " & """" & ActiveWorkbook.Name & """" & "<br>" & _
"Userid: " & UserName & "<br>" & _
"Excel: " & Excel_Version & " running on " & _
OS_Caption & " - " & OS_Version & "<br>" & _
"</font><br>"
' -----------------------------------------------------------------------------------------




With NewMail
.To = Cell3.Value

.CC = ""
.BCC = ""
.Subject = strHdr
.HTMLBody = Strbody
.Attachments.Add PdfFile
.Display
'' .Send
Sheets("Cona Forms").Activate
MsgBox "Go To Outlook.", vbInformation, "Message"
End With


' Delete PDF file


Kill PdfFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub


Function Format_HTML_Table_For_Outlook(strTable, strHdr)
strTable = ""
strHdr = ""
Sheets("Dashboard").Select
Cor_Req = Cells(5, 3).Value
Client = Cells(3, 3).Value
Plant = Cells(4, 3).Value
Serial = Cells(8, 3).Value
strTable = strTable & "<b>Correction Request : " & Cor_Req & "</b><br></b><br>"
strTable = strTable & "Client : " & Client & "</b></b><br>"
strTable = strTable & "Plant : " & Plant & "</b><br></b><br>"
strTable = strTable & "<Table> <TBody>" ' HTML Table Begin
strTable = strTable & "<tr> <th>Correction </th> <th>Required Information</th> </tr>"
For pctr = 7 To 78
If Rows(pctr & ":" & pctr).EntireRow.Hidden = False _
Then
fld1 = Cells(pctr, 2)
fld2 = Cells(pctr, 3)
strHdr = "Correction Request : " & Cor_Req & ", Plant : " & Plant & ", Serial # : " & Serial
strTable = strTable & "<tr> <td> " & _
fld1 & _
"</td><td>" & _
fld2 & "</td> </tr>"
End If
Next
strTable = strTable & "</TBody> </Table>" ' HTML Table End

End Function
********************************************

Any Help here?
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
I don't know what character did not show. Backslash is the usual one. Use code tags and paste code between. Click the # icon on reply toolbar to insert the tags.
Code: 
TempFilePath = Environ$("temp") & "\"
 
Upvote 0
Kenneth Hobson said:
I don't know what character did not show. Backslash is the usual one. Use code tags and paste code between. Click the # icon on reply toolbar to insert the tags.
Code: 
TempFilePath = Environ$("temp") & "\"
Click to expand...
Code: 
   Sub Send_PDF_As_Email()   Dim OlApp As Object
    Dim NewMail As Object
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileFullPath As String
 Set Cell3 = Range("X10")  'email recipient
      Sheets("Dashboard").Select
    Range("D5").Select
    ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""X"")"
    Range("D6").Select
    Sheets("Cona Forms").Select
    Range("E229:J229").Select
' file will be saved before
' sending it in email by attaching it.


    TempFilePath = Environ$("temp") & "\"


' Now append a date and time stamp
' in your pdf file name. Naming convention
' can be changed based on your requirement.


    TempFileName = "Equipment Control Request Form" & Format(Now, " dd-mmm-yyyy") & ".pdf"


'Complete path of the file where it is saved
    FileFullPath = TempFilePath & TempFileName


'Now Export the Activesshet as PDF with the given File Name and path


        With ActiveSheet
        .ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=FileFullPath, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    End With
'Now open a new mail


    Set OlApp = CreateObject("Outlook.Application")
    Set NewMail = OlApp.CreateItem(0)


    On Error Resume Next
 


    
    ' -----------------------------------------------------------------------------------------
   Call Format_HTML_Table_For_Outlook(strTable, strHdr)
'''    Set objMessage = CreateObject("CDO.Message")
    Strbody = Strbody & strTable
    
       Strbody = Strbody & "<br><br><br><br><br>" & _
             "<font size=1>" & _
              "Development Reference:" & "<br>" & _
              "Email generated using " & """" & ActiveWorkbook.Name & """" & "<br>" & _
              "Userid: " & UserName & "<br>" & _
              "Excel: " & Excel_Version & " running on " & _
                          OS_Caption & " - " & OS_Version & "<br>" & _
              "</font><br>"
    ' -----------------------------------------------------------------------------------------




With NewMail
    .To = Cell3.Value
    
    .CC = ""
    .BCC = ""
    .Subject = strHdr
    .HTMLBody = Strbody
    .Attachments.Add PdfFile
    .Display
''    .Send
     Sheets("Cona Forms").Activate
    MsgBox "Go To Outlook.", vbInformation, "Message"
End With


' Delete PDF file


  Kill PdfFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub


Function Format_HTML_Table_For_Outlook(strTable, strHdr)
    strTable = ""
    strHdr = ""
    Sheets("Dashboard").Select
    Cor_Req = Cells(5, 3).Value
    Client = Cells(3, 3).Value
    Plant = Cells(4, 3).Value
    Serial = Cells(8, 3).Value
    strTable = strTable & "<b>Correction Request : " & Cor_Req & "</b><br></b><br>"
    strTable = strTable & "Client : " & Client & "</b></b><br>"
    strTable = strTable & "Plant : " & Plant & "</b><br></b><br>"
    strTable = strTable & "<Table> <TBody>"     ' HTML Table Begin
    strTable = strTable & "<tr> <th>Correction </th> <th>Required Information</th> </tr>"
    For pctr = 7 To 78
        If Rows(pctr & ":" & pctr).EntireRow.Hidden = False _
        Then
           fld1 = Cells(pctr, 2)
           fld2 = Cells(pctr, 3)
            strHdr = "Correction Request : " & Cor_Req & ", Plant : " & Plant & ", Serial # : " & Serial
        strTable = strTable & "<tr> <td> " & _
                   fld1 & _
                   "</td><td>" & _
                   fld2 & "</td> </tr>"
        End If
    Next
    strTable = strTable & "</TBody> </Table>"   ' HTML Table End
    
End Function

Thank you
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Excel VBA to email multiple ranges as a PDF
Replies
0
Views
709
shophoney
S
Z
  • Question
VBA code to create a new workbook from multiple sheets of current workbook
Replies
9
Views
2K
Micron
M
G
  • Solved
How to send data as an attachment in PDF format.
Replies
7
Views
553
Sequoyah
Sequoyah
B
  • Question
add an existing pdf to an open outlook item
2
Replies
11
Views
766
ZVI
ZVI
P
  • Question
Edit VBA code to add new attachment on Email
Replies
3
Views
292
Persl
P

Forum statistics

Threads
1,215,746
Messages
6,126,648
Members
449,325
Latest member
Hardey6ix

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top