[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 6495
  • Last Modified:

Macro for Excel 2010 to save as PDF and then Email.

Hello, please can someone help me out with a macro.

I have attached a demo sheet like the excel sheet I will be working on.

I would like a macro button to print the active sheet which I am working on to the desktop as a PDF document with a concatenated file name of the salesman and the date

Example: Salesman107082014.pdf

Then email the PDF  to the email address which is stored on the active sheet in cell C1 with a subject of Commission Statement.

All the Salesman* sheets will have the macro button.

We use Excel 2010 and Outlook 2010

Anyone able to help me with this, any more information required please let me know.
0
DarrenEley
Asked:
DarrenEley
  • 9
  • 7
1 Solution
 
Rgonzo1971Commented:
Hi,

pls try

Sub SendSheetAsPDF()

  Dim olApp As Object
 
  Path = "c:\" ' pls adjust
  Salesman = ActiveSheet.Name
  strDate = Format(Date, "ddmmyyyy")
  If i > 1 Then PDF_File = Left(PDF_File, i - 1)
  PDF_File = Path & Salesman & strDate & ".pdf"
 
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_File, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  Set olApp = CreateObject("Outlook.Application")
  olApp.Visible = True

  With olApp.CreateItem(0)
    .Subject = "Report"
    .To = Range("C1")
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards,"
    .Attachments.Add PDF_File
    .Send

   
  End With
 
  ' if you want to delete it
  'Kill PDF_File
 
  olApp.Quit
  Set olApp = Nothing
 
End Sub

Open in new window

Regards
0
 
DarrenEleyAuthor Commented:
WOW that was quick, I will give it a try now.

Thank you.
0
 
Rgonzo1971Commented:
Corrected

Workbook name instead of sheetname as Salesman

Sub SendSheetAsPDF()

  Dim olApp As Object
 
  Path = "c:\" ' pls adjust
  Salesman = Split(ActiveWorkbook.Name, ".")(0) ' the only dot must be the one before xl*
  strDate = Format(Date, "ddmmyyyy")
  If i > 1 Then PDF_File = Left(PDF_File, i - 1)
  PDF_File = Path & Salesman & strDate & ".pdf"
 
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_File, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  Set olApp = CreateObject("Outlook.Application")
  olApp.Visible = True

  With olApp.CreateItem(0)
    .Subject = "Report"
    .To = Range("C1")
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards,"
    .Attachments.Add PDF_File
    .Send

   
  End With
 
  ' if you want to delete it
  'Kill PDF_File
 
  olApp.Quit
  Set olApp = Nothing
 
End Sub

Open in new window

0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
DarrenEleyAuthor Commented:
Hiya, When I run the macro with a push button a get a green status bar come up and then get

"Object doesn't support this property or method"

Regards

Darren
0
 
Rgonzo1971Commented:
Could you tell me at which line is the error (hint Debug)
0
 
DarrenEleyAuthor Commented:
olApp.Visible = True was highlighted on the debug.
0
 
DarrenEleyAuthor Commented:
Snip of debug
0
 
Rgonzo1971Commented:
pls delete that line

if you want to veriify the email before sending replace
.Send
at line 26 with
.Display

Regards
0
 
DarrenEleyAuthor Commented:
Hiya, Yep that fixed that perfectly :)

I have created a button for the sheets, however the email address shows up as salesman1 on every button, does not seem to take it from the active sheet.

The PDF does detect the active sheet and works perfectly.

Also outlook closes as soon as you close the email, would it be possible to save the email in the drafts automatically to be reviewed before sending out?

Really appreciate the assistance with this.

Regards

Darren
0
 
Rgonzo1971Commented:
pls try

Sub SendSheetAsPDF()

  Dim olApp As Object
 
  Path = "c:\" ' pls adjust
  Salesman = ActiveSheet.Name
  strDate = Format(Date, "ddmmyyyy")
  If i > 1 Then PDF_File = Left(PDF_File, i - 1)
  PDF_File = Path & Salesman & strDate & ".pdf"
 
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_File, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  Set olApp = CreateObject("Outlook.Application")


  With olApp.CreateItem(0)
    .Subject = "Report"
    .To = ActiveSheet.Range("C1")
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards,"
    .Attachments.Add PDF_File
    .Save
    .Display

   
  End With
 
  ' if you want to delete it
  'Kill PDF_File
 
  olApp.Quit
  Set olApp = Nothing
 
End Sub

Open in new window

0
 
DarrenEleyAuthor Commented:
Hiya, Thank you

It creates the email perfectly all the correct email address and file name.

It saves to drafts perfectly, but then close outlook completely, is it possible to stop this happening so it does not have to reopen outlook every time.

Regards

Darren
0
 
Rgonzo1971Commented:
Let's try

Sub SendSheetAsPDF()

  Dim olApp As Object
 
  Path = "c:\" ' pls adjust
  Salesman = ActiveSheet.Name
  strDate = Format(Date, "ddmmyyyy")
  If i > 1 Then PDF_File = Left(PDF_File, i - 1)
  PDF_File = Path & Salesman & strDate & ".pdf"
 
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_File, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  On Error Resume Next
  Set olApp = GetObject(, "Outlook.Application")
  If Err Then
    Set olApp = CreateObject("Outlook.Application")
  End If
  On Error Goto 0

  With olApp.CreateItem(0)
    .Subject = "Report"
    .To = ActiveSheet.Range("C1")
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards,"
    .Attachments.Add PDF_File
    .Save
    .Display

   
  End With
 
  ' if you want to delete it
  'Kill PDF_File
 
  Set olApp = Nothing
 
End Sub

Open in new window

0
 
DarrenEleyAuthor Commented:
Yep that's working, but the email says open and does not close and save in drafts.

Its not a massive issue just got to close down the email when it opens it.
0
 
Rgonzo1971Commented:
Then delete
 .Display
 at line 31
0
 
DarrenEleyAuthor Commented:
Excellent!!!

Thank you so much for you help with this...
0
 
DarrenEleyAuthor Commented:
Excellent!!! Simply Excellent!!!

Thank you. So very much..
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 9
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now