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

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
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

L
  • Locked
  • Question Question
How to stop VBA from creating pdf from drop-down list if the value is empty?
Replies
1
Views
340
Fluff
Fluff
L
  • Question Question
How to fix VBA code to stop saving and emailing PDF of blank cell from data validation list?
Replies
2
Views
298
lharr28
L
L
  • Question Question
How do I hide an attached image from the .htmlbody for mulitple emails?
Replies
3
Views
242
Anthony47
A
M
  • Question Question
Email file VBA - change attachment from excel to PDF?
Replies
2
Views
364
MOB
M
S
  • Question Question
Excel VBA to email multiple ranges as a PDF
Replies
0
Views
961
shophoney
S

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

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