VBA to create a button to pdf and email

chriswhincup

New Member
Joined
Apr 19, 2023
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Hi,
I'm trying to create a script that will pdf a worksheet based on the date and customer name in a cell (C4). I need it to save onto the desktop of whichever user is using the spreadsheet. I then want it to send it by email using outlook to an email address in cell I2 and CC to an email in I9.

This is how far I got which did work at first but now seems to error when adding the attachment but I cant work out where I've gone wrong. Happy to use an entirely different script if there's an easier way.

Sub SaveRangeAsPDF()

'Create and assign variables
Dim saveLocation As String
Dim ID As String
Dim ws As Worksheet
Dim rng As Range
Dim Eapp As Object
Set Eapp = CreateObject("Outlook.Application")
Dim EItem As Object
Set EItem = Eapp.createitem(0)

ID = Range("C4").Text
saveLocation = today + ID + ".pdf"
Set ws = Sheets("ORDER FORM")
Set rng = ws.Range("A1:L37")

'Save a range as PDF
rng.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation
user = Environ("Username")
desktop = "C:\users\" & Environ("Username") & "\Desktop"
today = Format(Now(), "DD-Mmm-YYYY")

With EItem
.To = Range("I2")
.CC = Range("I9")
.Subject = "Sales Order for " & ID
.Body = "Hi, Please find attached a new sales order. Thanks"
.Attachments.Add (today + ID + ".pdf")
.Display

End With

End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
VBA Code:
Sub SaveRangeAsPDF()

    'Create and assign variables
    Dim saveLocation As String
    Dim ID As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim Eapp As Object
    Set Eapp = CreateObject("Outlook.Application")
    Dim EItem As Object
    Set EItem = Eapp.createitem(0)

    Dim today As String
    today = Format(Now(), "DD-Mmm-YYYY")
    
    ID = Range("C4").Text
    saveLocation = desktop & "\" & today & " " & ID & ".pdf"
    Set ws = Sheets("ORDER FORM")
    Set rng = ws.Range("A1:L37")

    'Save a range as PDF
    rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation
    user = Environ("Username")
    desktop = "C:\users\" & Environ("Username") & "\Desktop"
    
    With EItem
        .To = Range("I2")
        .CC = Range("I9")
        .Subject = "Sales Order for " & ID
        .Body = "Hi, Please find attached a new sales order. Thanks"
        .Attachments.Add saveLocation
        .Display
    End With

End Sub
 
Upvote 0
VBA Code:
Sub SaveRangeAsPDF()

    'Create and assign variables
    Dim saveLocation As String
    Dim ID As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim Eapp As Object
    Set Eapp = CreateObject("Outlook.Application")
    Dim EItem As Object
    Set EItem = Eapp.createitem(0)

    Dim today As String
    today = Format(Now(), "DD-Mmm-YYYY")
   
    ID = Range("C4").Text
    saveLocation = desktop & "\" & today & " " & ID & ".pdf"
    Set ws = Sheets("ORDER FORM")
    Set rng = ws.Range("A1:L37")

    'Save a range as PDF
    rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation
    user = Environ("Username")
    desktop = "C:\users\" & Environ("Username") & "\Desktop"
   
    With EItem
        .To = Range("I2")
        .CC = Range("I9")
        .Subject = "Sales Order for " & ID
        .Body = "Hi, Please find attached a new sales order. Thanks"
        .Attachments.Add saveLocation
        .Display
    End With

End Sub
Hi, Thanks for this. Almost works but for some reason it saves it straight to the T:\ drive which is my network shared drive that I am not always connected to and not my desktop?

Otherwise is absolutely bang on what I need it to do.
 
Upvote 0
Ok, I see why. Here you go.

Excel Formula:
Sub SaveRangeAsPDF()

    'Create and assign variables
    Dim saveLocation As String
    Dim ID As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim Eapp As Object
    Set Eapp = CreateObject("Outlook.Application")
    Dim EItem As Object
    Set EItem = Eapp.createitem(0)

    Dim today As String
    today = Format(Now(), "DD-Mmm-YYYY")
    
    ID = Range("C4").Text
    desktop = Environ("USERPROFILE") & "\Desktop"
    saveLocation = desktop & "\" & today & " " & ID & ".pdf"
    Set ws = Sheets("ORDER FORM")
    Set rng = ws.Range("A1:L37")

    'Save a range as PDF
    rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation
    user = Environ("Username")
    
    With EItem
        .To = Range("I2")
        .CC = Range("I9")
        .Subject = "Sales Order for " & ID
        .Body = "Hi, Please find attached a new sales order. Thanks"
        .Attachments.Add saveLocation
        .Display
    End With

End Sub
 
Upvote 0
Ok, I see why. Here you go.

Excel Formula:
Sub SaveRangeAsPDF()

    'Create and assign variables
    Dim saveLocation As String
    Dim ID As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim Eapp As Object
    Set Eapp = CreateObject("Outlook.Application")
    Dim EItem As Object
    Set EItem = Eapp.createitem(0)

    Dim today As String
    today = Format(Now(), "DD-Mmm-YYYY")
   
    ID = Range("C4").Text
    desktop = Environ("USERPROFILE") & "\Desktop"
    saveLocation = desktop & "\" & today & " " & ID & ".pdf"
    Set ws = Sheets("ORDER FORM")
    Set rng = ws.Range("A1:L37")

    'Save a range as PDF
    rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation
    user = Environ("Username")
   
    With EItem
        .To = Range("I2")
        .CC = Range("I9")
        .Subject = "Sales Order for " & ID
        .Body = "Hi, Please find attached a new sales order. Thanks"
        .Attachments.Add saveLocation
        .Display
    End With

End Sub
Thanks for this. Works great with the exception that when it saves the file it removes all the inputted data from all the cells?? The form saves but anything that has been entered through the drop down lists or the manual entry is removed on saving. Its still there on screen so it hasn't wiped it. It just doesn't save it?
 
Upvote 0
Thanks for this. Works great with the exception that when it saves the file it removes all the inputted data from all the cells?? The form saves but anything that has been entered through the drop down lists or the manual entry is removed on saving. Its still there on screen so it hasn't wiped it. It just doesn't save it?
VBA Code:
Sub SaveRangeAsPDF()

    'Create and assign variables
    Dim saveLocation As String
    Dim ID As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim Eapp As Object
    Set Eapp = CreateObject("Outlook.Application")
    Dim EItem As Object
    Set EItem = Eapp.createitem(0)

    Dim today As String
    today = Format(Now(), "DD-Mmm-YYYY")
    
    ID = Range("C4").Text
    desktop = Environ("USERPROFILE") & "\Desktop"
    saveLocation = desktop & "\" & today & " " & ID & ".pdf"
    Set ws = Sheets("ORDER FORM")
    
    'Unhide all rows and columns
    ws.Cells.EntireRow.Hidden = False
    ws.Cells.EntireColumn.Hidden = False
    
    Set rng = ws.Range("A1:L37")

    'Save a range as PDF
    rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation
    user = Environ("Username")
    
    'Hide all rows and columns again
    ws.Cells.EntireRow.Hidden = True
    ws.Cells.EntireColumn.Hidden = True
    
    With EItem
        .To = Range("I2")
        .CC = Range("I9")
        .Subject = "Sales Order for " & ID
        .Body = "Hi, Please find attached a new sales order. Thanks"
        .Attachments.Add saveLocation
        .Display
    End With

End Sub
 
Upvote 0
VBA Code:
Sub SaveRangeAsPDF()

    'Create and assign variables
    Dim saveLocation As String
    Dim ID As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim Eapp As Object
    Set Eapp = CreateObject("Outlook.Application")
    Dim EItem As Object
    Set EItem = Eapp.createitem(0)

    Dim today As String
    today = Format(Now(), "DD-Mmm-YYYY")
   
    ID = Range("C4").Text
    desktop = Environ("USERPROFILE") & "\Desktop"
    saveLocation = desktop & "\" & today & " " & ID & ".pdf"
    Set ws = Sheets("ORDER FORM")
   
    'Unhide all rows and columns
    ws.Cells.EntireRow.Hidden = False
    ws.Cells.EntireColumn.Hidden = False
   
    Set rng = ws.Range("A1:L37")

    'Save a range as PDF
    rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation
    user = Environ("Username")
   
    'Hide all rows and columns again
    ws.Cells.EntireRow.Hidden = True
    ws.Cells.EntireColumn.Hidden = True
   
    With EItem
        .To = Range("I2")
        .CC = Range("I9")
        .Subject = "Sales Order for " & ID
        .Body = "Hi, Please find attached a new sales order. Thanks"
        .Attachments.Add saveLocation
        .Display
    End With

End Sub
Thank you. That shows the data I have inputted but it also unhides a couple of columns I need to to be hidden on the pdf. Is there a way to keep these hidden?
 
Upvote 0
Thank you. That shows the data I have inputted but it also unhides a couple of columns I need to to be hidden on the pdf. Is there a way to keep these hidden?
VBA Code:
Sub SaveRangeAsPDF()

    'Create and assign variables
    Dim saveLocation As String
    Dim ID As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim Eapp As Object
    Set Eapp = CreateObject("Outlook.Application")
    Dim EItem As Object
    Set EItem = Eapp.createitem(0)

    Dim today As String
    today = Format(Now(), "DD-Mmm-YYYY")
    
    ID = Range("C4").Text
    desktop = Environ("USERPROFILE") & "\Desktop"
    saveLocation = desktop & "\" & today & " " & ID & ".pdf"
    Set ws = Sheets("ORDER FORM")
    
    Set rng = ws.Range("A1:L37")

    'Save a range as PDF
    rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation
    user = Environ("Username")
    
    With EItem
        .To = Range("I2")
        .CC = Range("I9")
        .Subject = "Sales Order for " & ID
        .Body = "Hi, Please find attached a new sales order. Thanks"
        .Attachments.Add saveLocation
        .Display
    End With

End Sub
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

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