Vba Macro - print a specified range to Pdf - send by Outlook - specified subject/body in a cell.

[fleyd]

Hello,

I´m not and expert in VBA, and i searched the web for a Macro that would do this:
- can print to A4 PDF a specified range in a cell
- Save that PDF to a specified destination in a cell
- Save that PDF with a specific name specified in a cell
- send by Outlook that PDF attachement
- with specified subject/body as a specific a cell
- Email destination and cc as specified in a cell

I managed to find a Macro that does part of this, but not everything. Here´s an Example sheet

Can someone help with the rest of the code to do this?

Feel free to download the file. Many thanks in advance for the help.

 

[jolivanes]

Do a Google search on how to act when cross posting

 

[fleyd]

Do a Google search on how to act when cross posting

What do you mean?

 

[fleyd]

Do a Google search on how to act when cross posting

I´m just trying to get help, but for what i understand when i place the same question in 2 forums i need to reference the other, is that it?
If that´s the case, here it is the other forum where i place the question Ozgrid

I´m not trying to cheat anybody, i´m just looking for help about the macro.

Can you help?

 

[jolivanes]

Yes indeed.
It's free and you could potentially have several people working on the same problem while there could be a solution already.
It would be a waste of their time. They could have been helping people that did not have a solution yet.
But you have supplied the hyperlink. Thank you for that.

 

[fleyd]

Yes indeed.
It's free and you could potentially have several people working on the same problem while there could be a solution already.
It would be a waste of their time. They could have been helping people that did not have a solution yet.
But you have supplied the hyperlink. Thank you for that.

Honestly, it wasn´t my intention to "harm" anyone...

I not getting the code to work and i´m stoping for a bit now.

Hope someone can help.

 

[jolivanes]

I can't help you but have a look at this site.
The saving to PDF should be straight forward.

Home | Ron de Bruin Excel Automation

Welcome to https://www.rondebruin.nl

www.rondebruin.nl

 

[jolivanes]

Just an example.
Change the references where required.
Range("A1") has "A1:J45", without the double quotation marks, in it.
Range("A2") has "C:\Temp", without the double quotation marks, in it.
Range("A3") has "Satifaction Report Comp AAAAA", without the double quotation marks, in it.

Sub Maybe()
Dim FilePath As String
    With Sheets("Sheet1")    '<---- Change sheet name
        FilePath = Range("A2").Value & "\" & Range("A3").Value & ".PDF"    '<---- Change the reference
            .Range(.Range("A1").Value).ExportAsFixedFormat 0, FilePath    '<---- Change the reference
    End With
End Sub

 

[fleyd]

Hi, I have seen that website but i find it more complicated than another i also found on the web.

So far i´m still missing this:
Important to me
- Choose the range in the sheet to print to Pdf (it can be on the Vba code, but i would prefer a sheet cell reference)
- Choose the name of the sheet to print, because this macro can be useful for other sheets i have ((it can be on the Vba code, but i would prefer a sheet cell reference)

Not so important:
- Choose the computer path to save the document "c:\pdf_prints\" for example . I would prefer to write the path in a excel cell, it´s more flexible to use in another sheets
- Is there a way of deleting the pdf file? Just send it in the email.

This is the file i have so far Excel example

Sub Save_as_pdf_and_send()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
 
Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
 
If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox ActiveSheet.Range("n9") & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
'xFolder = ActiveSheet.Range("n9") 'Not working properly
xFolder = xFolder + "\" + ActiveSheet.Range("n10") + ".pdf"  'xSht.Name + ".pdf"_Can´t_have_bars
 
'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If
 
Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file
    xSht.ExportAsFixedFormat Type:=xlTypePDF, FileName:=xFolder, Quality:=xlQualityStandard
     
    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .to = ActiveSheet.Range("n5")
        .CC = ActiveSheet.Range("n6")
        .Subject = ActiveSheet.Range("n7")
        .HTMLBody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & " size=" & Chr(34) & 4 & Chr(34) & ">" & "Good day dear Master," & "<br> <br>" & ActiveSheet.Range("n8") & "<br> <br>" & signature & "</font>"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

 

[jolivanes]

Can you change this to suit your needs?
Change all references etc where required.

Cell A1 has "Sheet1" without the quotation marks in it
Cell A2 Has "A1:J45" without the quotation marks in it
Cell A3 has "C:\TempFolder" without the quotation marks in it
Cell A4 has "Trial File" without the quotation marks in it
Cell A5 has "Hello" without the quotation marks in it

Sub Mail_PDF()

    Dim PDF_To_Mail As String
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Sheets(Range("A1").Value)
        PDF_To_Mail = Range("A3").Value & "\" & Range("A4").Value & ".PDF"
            .Range(.Range("A2").Value).ExportAsFixedFormat 0, PDF_To_Mail
    End With

    On Error Resume Next

    With OutMail
        .To = "fleyd321@hotmail.com"
        .CC = ""
        .BCC = ""
        .Subject = Range("A5").Value & " Latest News"
        .body = ""
        .Attachments.Add(PDF_To_Mail).FullName
        .send
    End With
    On Error GoTo 0

    Kill PDF_To_Mail

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub