Macro to Save file both as an excel macro-enabled workbook and PDF and attach to an email

[SanFelippo]

Hi,

I have this nifty macro that saves a temp copy of the workbook and attaches it to an email. After a copy has been attached, it then deletes that temp copy. It works perfectly right now, but I was wondering if it could be possible to have it also save the workbook as a PDF and attach it to the email as well? I would want it to then delete the temp PDF copy it made after it is attached, just like it does the Excel copy.

Any ideas how to do that?

[Sub Submit_Button_Tab_1()
If Range("B5").Value = "No" Then
'Working in Excel 2000-2016
'Mail a copy of the ActiveWorkbook with another file name
Dim wb1 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb1 = ActiveWorkbook
'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = Format(Now, "mm-dd-yy") & " " & wb1.Name
'FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "[EMAIL="SomeonesEmail@abna.com"]SomeonesEmail@abna.com[/EMAIL]"
.cc = ""
.BCC = ""
.Subject = "Subject Line"
.Body = ""
.Attachments.Add TempFilePath & TempFileName & FileExtStr
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
'.Send or use'
.Display
End With
On Error GoTo 0
'Delete the file
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Else
    MsgBox "Can only submit on this sheet if 2nd HMDA Determination Question is answered 'No'"
End If
End Sub
/CODE]

 

[ShawnPCooke]

You can save to PDF with the statement below. (Change variable names to your own)

WorkbookName.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "Filepath\Filename.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True

 

[SanFelippo]

Sorry, but I am not exactly sure how to work that into what I already have.

 

[SanFelippo]

Any chance you or someone could give a little more guidance as to how I work that into what I already have?

 

[John_w]

Try this:

Sub Submit_Button_Tab_1()

    'Working in Excel 2000-2016
    'Mail a copy of the ActiveWorkbook with another file name and as a PDF file
    
    Dim wb1 As Workbook
    Dim TempFilePath As String
    Dim TempWorkbookFileName As String, TempPDFFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    If Range("B5").Value <> "No" Then
        MsgBox "Can only submit on this sheet if 2nd HMDA Determination Question is answered 'No'"
        Exit Sub
    End If
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Set wb1 = ActiveWorkbook
    
    'Make a copy of the file/Open it/Mail it/Delete it
    'If you want to change the file name then change only TempFileName
    
    TempFilePath = Environ$("temp") & "\"
    TempWorkbookFileName = TempFilePath & Format(Now, "mm-dd-yy") & " " & wb1.Name
    TempPDFFileName = TempFilePath & Format(Now, "mm-dd-yy") & " " & Replace(wb1.Name, ".xlsm", ".pdf", compare:=vbTextCompare)
    'FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
    wb1.SaveCopyAs TempWorkbookFileName
    
    'Save workbook as PDF
    
    wb1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempPDFFileName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = "SomeonesEmail@abna.com"
        .cc = ""
        .BCC = ""
        .Subject = "Subject Line"
        .Body = ""
        .Attachments.Add TempWorkbookFileName
        .Attachments.Add TempPDFFileName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        '.Send or use'
        .Display
    End With
    On Error GoTo 0
    
    'Delete the files
    Kill TempWorkbookFileName
    Kill TempPDFFileName
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub

 

[SanFelippo]

AWESOME. Does exactly what I needed it to.

Thanks!