Excel Macro (VBA) sending active worksheet in PDF by Outlook

[Exceluser2014]

Dear all,

Can anyone help me with this problem. I find out a code to create a PDF (with opening the Save As dialog box) from an active worksheet, but I can't find out how to send this PDF by e-mail (Outlook). The code is working till the words 'Set OutApp'.

Please can anyone help me? Just what I want is to send the active worksheet as PDF (as attachment) by email (Outlook). Here the present code.

Sub SendPDF()
'
' SendPDF Macro
'
    Dim OutApp As Object
    Dim OutMail As Object
    Dim v As Variant
    v = Application.GetSaveAsFilename(Range("E2").Value, "PDF Files (*.pdf), *.pdf")
         
    If VarType(v) <> vbString Then Exit Sub
     
    If Dir(v) <> "" Then
        If MsgBox("File already exists - do you wish to overwrite it?", vbYesNo, "File Exists") = vbNo Then Exit Sub
    End If
     
    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, FileName:=v, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=False
    End With
         
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add v
        .Send
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Thanks in advance for all your help and suggestions.

Regards,

Gerben

 

[wigi]

Did you try:

MsBox Environ("Temp")

to see what it gives you?

You should use this in the code for ExportAsFixedFormat.

 

[micfly]

Sorry, you're a little over my head. Can you expand a little?

 

[wigi]

Sorry, you're a little over my head. Can you expand a little?

If you create a new empty file and put some contents in cells, then run (notice that this code comes from the code in this topic, and is only slightly changed):

With ActiveSheet        .ExportAsFixedFormat Type:=xlTypePDF, FileName:=Environ("Temp") & "\test", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=False
    End With

The file test.pdf is created in the Temp folder. Go to Windows Explorer, as the location, type %temp% and find the generated PDF file...

 

[micfly]

Sorry, I'm still confused. Using the code in this topic with your modification the save as dialog still pops up.
That's what I was trying to avoid. I don't really need to save it or look for it anywhere. I just want it attached to an email.
This is the code I'm trying.

Sub SendPDF()
'
' SendPDF Macro
'
    Dim OutApp As Object
    Dim OutMail As Object
    Dim v As Variant
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    v = Application.GetSaveAsFilename(Range("B9").Value, "PDF Files (*.pdf), *.pdf")
         
    If VarType(v) <> vbString Then Exit Sub
     
    If Dir(v) <> "" Then
        If MsgBox("File already exists - do you wish to overwrite it?", vbYesNo, "File Exists") = vbNo Then Exit Sub
    End If
     
    With ActiveSheet
       .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Environ("Temp") & "\test", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=False
    End With
         
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add v
        .Send
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
   Application.ScreenUpdating = True
   Application.EnableEvents = True
End Sub

 

[micfly]

Oops, one change was not included in above code. I had changed the .Send to .Display, everything else is the same.

 

[wigi]

That's the point You can get rid of all that code regarding the save as.

Specifically, you can delete

v = Application.GetSaveAsFilename(Range("B9").Value, "PDF Files (*.pdf), *.pdf")         
    If VarType(v) <> vbString Then Exit Sub
     
    If Dir(v) <> "" Then
        If MsgBox("File already exists - do you wish to overwrite it?", vbYesNo, "File Exists") = vbNo Then Exit Sub
    End If

and even more lines. The thing is that only ExportAsFixedFormat is sufficient if you have a path (temp) and a filename (test.pdf) in this case.

 

[micfly]

Okay, thanks for hanging with me. Trying this at home now (was on work computer).
This all works now, no save as prompt, and the email pops up, but, with no attachment? I have Outlook 2013 installed on this computer.
Trying this...

Sub SendToPDF()
'
' SendPDF Macro
'
    Dim OutApp As Object
    Dim OutMail As Object
    Dim v As Variant
        Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' v = Application.GetSaveAsFilename(Range("b39").Value, "PDF Files (*.pdf), *.pdf")
         
    ' If VarType(v) <> vbString Then Exit Sub
     
    ' If Dir(v) <> "" Then
     '   If MsgBox("File already exists - do you wish to overwrite it?", vbYesNo, "File Exists") = vbNo Then Exit Sub
    ' End If
     
     With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Environ("Temp") & "\Schedule", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=False
     End With
         
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add v
        .Display  ' changed from .Send
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub

 

[wigi]

You use:

.Attachments.Add v

but v is not used? That is not going to work, is it?

 

[micfly]

Any other ideas?

 

[wigi]

Any other ideas?

Didn't you see my post above?

When adding the attachment to the email, you use (the empty) v instead of the file Schedule.pdf located in the Temp directory.