Macro to print first 2 pages of current sheet as pdf and email

[Tosborn]

Macro to print first 2 pages of current sheet as pdf and email

Hey there,

Could someone please help me out with a macro. Need the macro to print out the first 2 pages of the active sheet as a pdf and save in a specified directory.

Could we then have another macro to complete the same as above but then also prepare an email with the pdf attached to the email. The email address to send to is stored in B12 of the active sheet.

We could also have the cc of the email and the body of the email also stored in U7 & U8 of the active sheet.

Thanks so much. This is gonna save me a bunch of time.

Love my mr. excel msg board, complete life saver.

Tim

 

[CalcSux78]

...
Thanks so much. This is gonna save me a bunch of time.

Tim,

Have you attempted anything yet or are you requesting that someone on the forum complete your project for you?

 

[Tosborn]

Hi Calc,

Sorry I should have provided a bit more information in my original post.

I've got some code that I've been using to save the file as PDF however it doesn't also save the filename as is specified in the cell. I've been trying to add to the code but without much luck. Im still learning at VBA so hence my trouble.

I'm away from my computer for a few days (posting on my phone right now) but when I get back I'll post my code that I've been using so far.

I also have some code that can email a spreadsheet but not in PDF form, will review this too.

Cheers,
Tim

 

[Momentman]

Havent tested this but this should get you started, hopefully you are using Outlook

Sub CreateOutlook()
    Dim wks As Worksheet
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim fiilestr As String
    
    Set wks = ActiveSheet
    filestr = "C:\Users\victor\Desktop\Testfile.txt"
    Application.ScreenUpdating = False
    
    'Code to Print
    wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filestr, IgnoreprintReaas:=False, From:=1, To:=2, openAfterpublish:=False
    
    Set OutApp = CreateObject("Outlook.application")
    
    Set OutMail = OutApp.CreateItem(olMailItem)
    With OutMail
        .To = wks.Range("B12").Value
        .CC = wks.Range("U7").Value
        '.BCC = "testing@live.com"
        .Subject = "Meet up to Discuss"
        .Body = wks.Range("U8").Value
        .Attachments.Add filestr
        .Send
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

 

[Tosborn]

Hi Momentman,

Thanks for the code. I tried to run this however it returns a "compile error: User defined type not defined"

I've selected from the references "microsoft DAO 3.6 object library after googling the problem however the problem still remains. Any ideas?

I'm running office 2013 btw.

Thanks
Tim

 

[Momentman]

You need to add a reference "Microsoft outlook library"

 

[Tosborn]

This is awesome thanks so much.

Was playing with it a bit to tweak it.

How do I set the filestr to add in the directory also? (you see where I've tried and failed :P)

Also, how can I change the code so I can review the email before it gets sent?

Sub CreateOutlook()
    Dim wks As Worksheet
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim fiilestr As String
    
    Set wks = ActiveSheet
    filestr = "E:\VBA\BT.pdf" '-  for hardcoded filename
    'filestr = "e:\vba\" & Cells(27, "K").Value
    Application.ScreenUpdating = False
    
    'Code to Print
    
    'wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filestr, IgnoreprintaReas:=False, From:=1, To:=2, openAfterpublish:=False
    wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filestr, IgnoreprintaReas:=False, From:=1, To:=2, openAfterpublish:=False
    
    'Filename = Cells(7, "E").Value & ".xlsx"
    
    Set OutApp = CreateObject("Outlook.application")
    
    Set OutMail = OutApp.CreateItem(olMailItem)
    With OutMail
        .To = wks.Range("B12").Value
        .CC = wks.Range("U7").Value
        '.BCC = "testing@live.com"
        .Subject = "Meet up to Discuss"
        .Body = wks.Range("U8").Value
        .Attachments.Add filestr
        .Send
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

 

[Tosborn]

Update, i figured out how to show the email before sending....

.display instead of .send - hahaa, so easy.

 

[Momentman]

Update, i figured out how to show the email before sending....

.display instead of .send - hahaa, so easy.

Apologies, i have been away from my PC. I hope you have everything working now

 

[Tosborn]

Hi Momentman,

yeah all good on the email review before sending.


But I'm still stuck on the file name 'filestr', if we use:

filestr = "e:\vba\bt.pdf"

this will hardcode in the file name & directory. However as I am using it on multiple sheets I would like the filename to change with the cell reference.

filestr = cells(27, "K").value

works but I have trouble with the attachment for the email not being able to find the file as the variable 'filestr' does not contain information regarding the directory of the file.

So I need to add in the directory reference to the line:

filestr = cells(27, "K").value

Thanks,
Tim