VBA to create a button to pdf and email

C

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

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
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
ChrisFoster said:
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
Click to expand...
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
ChrisFoster said:
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
Click to expand...
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
chriswhincup said:
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?
Click to expand...
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
ChrisFoster said:
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
Click to expand...
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
chriswhincup said:
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?
Click to expand...
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
You must log in or register to reply here.

Similar threads

F
  • Question
VBA Email formatting
Replies
4
Views
487
floggingmolly
F
F
  • Question
VBA to create emails creating blank emails if only 1 row of data
Replies
1
Views
314
Micron
M
J
  • Question
PDF to Email
Replies
6
Views
239
dermie_72
D
A
  • Question
Method 'To' of object '_MailItem' failed
Replies
1
Views
466
aleksa02
A
T
  • Question
VBA Error when Saving range to Pdf or trying to email range
Replies
1
Views
296
OaklandJim
O

Forum statistics

Threads
1,214,652
Messages
6,120,746
Members
448,989
Latest member
mariah3

Share this page

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