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.
DarrenEleyAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
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
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.