MilkyTech
MilkyTech

Reputation: 1927

Excel VBA: Saving and Attaching a worksheet as pdf

I have combined some code from a couple of different examples to get this to work but my solution seems klunky in that I am creating 2 pdfs. One in a temp folder, and one in the current folder. The one in the temp folder is the one getting attached to the email. I would like to just save a single pdf in the current folder and attach that pdf to the email.
This is the code that exports both pdf's:

 Title = ActiveSheet.Range("B11").Value & " Submittal"

' Define PDF filename in TEMP folder
PdfFile = ActiveWorkbook.Name
i = InStrRev(PdfFile, ".xl", , vbTextCompare)
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = Title
For Each char In Split("? "" / \ < > * | :")
PdfFile = Replace(PdfFile, char, "_")
Next
PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B11").Value & " Submittal", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With

For some reason, if I add ThisWorkbook.Path & "\" to the Filename of the first exported file like this: Filename:=ThisWorkbook.Path & "\" & PdfFile, so it saves in the current folder instead of the temp folder, I get a runtime error and it doesn't save even though this is the same code that exports the second pdf file successfully to the current folder. Here is the full working code but I want to eliminate the temp pdf if possible:

Sub RightArrow2_Click()
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Dim i As Long
  Dim char As Variant

Title = ActiveSheet.Range("B11").Value & " Submittal"

' Define PDF filename in TEMP folder
PdfFile = ActiveWorkbook.Name
i = InStrRev(PdfFile, ".xl", , vbTextCompare)
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = Title
For Each char In Split("? "" / \ < > * | :")
PdfFile = Replace(PdfFile, char, "_")
Next
PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
'Debug.Print PdfFile

' Export activesheet as PDF to the temporary folder
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B11").Value & " Submittal", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With

' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
On Error GoTo 0

' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)

' Prepare e-mail
.Subject = Title
.To = ActiveSheet.Range("H12").Value 
.CC = "" 
.Body = "Please see the attached submittal for " & ActiveSheet.Range("B11").Value & "." & vbLf & vbLf _
      & "Thank you," & vbLf & vbLf _
      & vbLf
.Attachments.Add PdfFile

' Display email
On Error Resume Next
.Display ' or use .Send

' Return focus to Excel's window
Application.Visible = True
If Err Then
  MsgBox "E-mail was not sent", vbExclamation
Else
  MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0

End With
' Delete the temporary PDF file
If Len(Dir(PdfFile)) Then Kill PdfFile

' Try to quit Outlook if it was not previously open
If IsCreated Then OutlApp.Quit

' Release the memory of object variable
' Note: sometimes Outlook object can't be released from the memory
Set OutlApp = Nothing
End Sub

Upvotes: 1

Views: 9650

Answers (2)

L42
L42

Reputation: 19727

First, remove this line:

PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) _ 
          & "\" & PdfFile, 251) & ".pdf"

And then this line:

With ActiveSheet
   .ExportAsFixedFormat Type:=xlTypePDF, _
                        Filename:=ThisWorkbook.Path _
                                  & "\" & .Range("B11").Value & " Submittal", _
                        Quality:=xlQualityStandard, _
                        IncludeDocProperties:=True, _
                        IgnorePrintAreas:=False, _
                        OpenAfterPublish:=False
End With

I am not sure how you're creating your filename for your PDF but it should be something like this:

  1. If you retrieve it from a Range:

    With Thisworkbook
        PdfFile = .Path & Application.PathSeparator & _
                  .Sheets("SheetName").Range("B11") & "Submittal.pdf"
    End With
    
  2. If you need to do manipulations on the text like what you did:

    Title = ActiveSheet.Range("B11").Value & " Submittal"
    PdfFile = Title
    For Each c In Split("? "" / \ < > * | :")
        PdfFile = Replace(PdfFile, char, "_")
    Next
    PdfFile = Thisworkbook.Path & Application.PathSeparator & PdfFile & ".pdf"
    

Once you've created a valid filename, the below code should work:

With ActiveSheet
   .ExportAsFixedFormat Type:=xlTypePDF, _
                        Filename:=PdfFile, _
                        Quality:=xlQualityStandard, _
                        IncludeDocProperties:=True, _
                        IgnorePrintAreas:=False, _
                        OpenAfterPublish:=False
End With

Upvotes: 1

ChipsLetten
ChipsLetten

Reputation: 2953

In your description, in the line of code Filename:=ThisWorkbook.Path & "\" & PdfFile the PdfFile variable contains the path to the temp folder which is why you get the error.

Upvotes: 2

Related Questions