Solved

Excel - problem combining a created PDF and emailing it using VBA

Posted on 2012-04-04
6
291 Views
Last Modified: 2012-08-14
Hi

I have a spreadsheet that creates a PDF from a userform where I can select the worksheets I require.

I have  a couple of issues:

1. For the life of me I can't work out how to change the location of the PDF before it saves it to the local users my documents. (Module5)
2. How to combine my email VBA (Module3) with to allow me create a PDF using Userform1 to then email it.

Ideally I would like to have the option to email or print.

See Attached file
Price-List-03-04-12.xlsm
0
Comment
Question by:shawks
  • 3
  • 3
6 Comments
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
>>1. For the life of me I can't work out how to change the location of the PDF before it saves it to the local users my documents. (Module5)

The original code in your Userform, associated with the PDF Selected Sheets click button (CommandButton1_Click()) has this statement:

Call printSheetsToPDF(strsheets, getFileNameOnly(ThisWorkbook.FullName) & ".PDF")

Open in new window


Its that second parameter that dictates where the PDF file is created, so if you want to save to a different location/rename the file, code the statement like:

Private Sub CommandButton1_Click()
Dim ctrl As Control
Dim myDict As Object
Dim wks As Worksheet
Dim strsheets As String
dim pdFile as string
   
...
...
    pdFile = "\\myServer\path\myPDFile.PDF"
    call printSheetsToPDF(strsheets,pdFile)

...
...

Open in new window


I created a copy of your Email_Template() routine in the same module, modifying it to take a parameter (pdFile - full path and filename of PDF file):

Sub Email_PDF(pdFile As String) 'pdFile is passed as full path and filename of PDF
'
' Email_Template Macro
' For the code to email
'
Dim OutApp As Object
Dim OutMail As Object
Dim Recipients As String, c As Range
Dim CustName As Range
    
Set CustName = Sheets("Discount Structure Control").Range("D6")
For Each c In Sheets("Discount Structure Control").Range("N6:N10").CurrentRegion
        Recipients = Recipients & ";" & c.Value
    Next c
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
 ' Change the mail address and subject in the macro before you run it.

With OutMail
    .To = Recipients
    .Cc = ""
    .Bcc = ""
    .Subject = ActiveSheet.Name & " Price List From ArtSystems"
    .Body = "Dear Customer" & Chr(10) & Chr(10) & "Please find attached a copy of our latest " & ActiveSheet.Name & " Price List." & Chr(10) & Chr(10) & "Best Regards"
    .Attachments.Add (pdFile)
    .Display
     '.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Open in new window


Finally, I modified your userform to prompt for Email or Print of PDF File, executing on the OK button.  Note, I modified the printSheetsToPDF to accept a 3rd parameter (TRUE/FALSE) called bPrint which would print to the active printer if TRUE, along with generating the PDF:

Here's the modified printSheetsToPDF routine
Sub printSheetsToPDF(strSheetsToPrint As String, pdfFile As String, bPrint As Boolean)
Dim wkb As Workbook
Dim wks As Worksheet
Dim vSheets As Variant
Dim myDict As Object
Dim myDictVisible As Object
Dim i As Long

    Set wkb = ThisWorkbook
    Set wks = ActiveSheet
    Set myDict = CreateObject("Scripting.Dictionary")
    Set myDictVisible = CreateObject("Scripting.Dictionary")
    
    vSheets = Split(strSheetsToPrint, ",")
    
    'capturing visibility
    For Each wks In wkb.Sheets
        myDictVisible.Add (wks.Name), wks.Visible
    Next wks
    
    'make PDF sheets visible
    For i = LBound(vSheets) To UBound(vSheets)
        wkb.Sheets(vSheets(i)).Visible = xlSheetVisible
        myDict.Add vSheets(i), Nothing
    Next i
    
    'make all other sheets not visible
    For Each wks In wkb.Sheets
        If Not myDict.exists(wks.Name) Then
            wks.Visible = xlSheetHidden
        End If
    Next wks
        
    'select sheets to print (not really necessary, as all visible sheets will be printed with the ExportAsFixedFormat method
    'wkb.Sheets(vSheets).Select
    
    On Error Resume Next 'this method must exist, and should in Excel 2007+.  Excel 2007 latest SP has this addin, otherwise, it can be downloaded at http://labnol.blogspot.com/2006/09/office-2007-save-as-pdf-download.html
    
    If Dir(pdfFile) <> vbNullString Then
        Kill pdfFile
        If Err.Number <> 0 Then
            MsgBox "Cannot delete PDF File: " & pdfFile & " You may have it open - close it and try again"
            Exit Sub
        End If
    End If
    
    Err.Clear
    wkb.ExportAsFixedFormat Type:=xlTypePDF, FileName:=pdfFile, quality:=xlQualityStandard, includedocproperties:=True, _
                            ignoreprintareas:=False, openafterpublish:=True
                            
    If Err.Number <> 0 Then
        MsgBox "Could not successfully create PDF file, perhaps you need to ensure you're running Excel 2007 with latest patches or Excel 2010"
    End If
    On Error GoTo 0
    
    'print Selected sheets, as needed
    If bPrint Then
        wks.PrintOut
    End If
    
    'restore to prior visibility
    For Each wks In wkb.Sheets
        wks.Visible = myDictVisible(wks.Name)
    Next wks
    
    myDict.RemoveAll
    myDictVisible.RemoveAll
    Set myDict = Nothing
    Set myDictVisible = Nothing
Sheets("Discount Structure Control").Select
Range("A1").Select
End Sub

Open in new window


Here's the Email_PDF() routine:
Sub Email_PDF(pdFile As String) 'pdFile is passed as full path and filename of PDF
'
' Email_Template Macro
' For the code to email
'
Dim OutApp As Object
Dim OutMail As Object
Dim Recipients As String, c As Range
Dim CustName As Range
    
Set CustName = Sheets("Discount Structure Control").Range("D6")
For Each c In Sheets("Discount Structure Control").Range("N6:N10").CurrentRegion
        Recipients = Recipients & ";" & c.Value
    Next c
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
 ' Change the mail address and subject in the macro before you run it.

With OutMail
    .To = Recipients
    .Cc = ""
    .Bcc = ""
    .Subject = ActiveSheet.Name & " Price List From ArtSystems"
    .Body = "Dear Customer" & Chr(10) & Chr(10) & "Please find attached a copy of our latest " & ActiveSheet.Name & " Price List." & Chr(10) & Chr(10) & "Best Regards"
    .Attachments.Add (pdFile)
    .Display
     '.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Open in new window


And here's the modified Userform routine (note two checkboxes were added to the userform, cbPrint and cbPDF, so you can either print/generate PDF or do both):

Private Sub CommandButton1_Click()
Dim ctrl As Control
Dim myDict As Object
Dim wks As Worksheet
Dim strsheets As String
Dim pdFile As String
Dim bPrint As Boolean

    Set myDict = CreateObject("Scripting.Dictionary")
    
    For Each wks In ThisWorkbook.Sheets
        myDict.Add wks.Name, Nothing
    Next wks
    
    For Each ctrl In Me.Controls
        If myDict.exists(ctrl.Caption) Then 'there's a corresponding worksheet with same name as checkbox caption
            If ctrl.Value Then
                If strsheets = vbNullString Then
                    strsheets = ctrl.Caption
                Else
                    strsheets = strsheets & "," & ctrl.Caption
                End If
            End If
        End If
    Next ctrl
    
    pdFile = getFileNameOnly(ThisWorkbook.FullName) & "*.PDF" 'change path and/or filename of PDF here
    bPrint = Me.cbPrint.Value
    
    Call printSheetsToPDF(strsheets, pdFile, bPrint)
    
    If Me.cbEmail.Value = True Then
        Call Email_PDF(pdFile)
    End If
    
    Unload Me
    
    myDict.RemoveAll
    Set myDict = Nothing
End Sub

Open in new window


See attached.

Enjoy!

Dave
Price-List-03-04-12-r1.xlsm
0
 

Author Comment

by:shawks
Comment Utility
Hi Dave

Thanks again! - I have a error when I run the code :

"Could not successfully create PDF file, perhaps you need to ensure you're running Excel 2007 with latest patches or Excel 2010"

which didn't occur previously  it stops at the section of code:

If Err.Number <> 0 Then
        MsgBox "Could not successfully create PDF file, perhaps you need to ensure you're running Excel 2007 with latest patches or Excel 2010"
    End If
    On Error GoTo 0
   
    'print Selected sheets, as needed
    If bPrint Then
        wks.PrintOut

Not sure if its something I'm doing.

Steve
0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
Did you copy ALL the code over?

When it stops, can you go to the immediate window and type:

Debug.Print pdFile

And advise what that is?  Is that path correct?  You have to enter the path and filename correctly or you'd get an error trying to create the file.

Dave
0
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 

Author Comment

by:shawks
Comment Utility
I used the Solution Demonstrated file to ensure I understood how it worked before transfering the code.

Went with the standard coding for the file path first - for same reason

when I do Debug.Print pdfile I get

wks=nothing

Steve
0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
Comment Utility
Apologies- I introduced a couple type-o's.  Tested correct.  In the Userform code, line 27 should read:

pdFile = getFileNameOnly(ThisWorkbook.FullName) & ".PDF" 'change path and/or filename of PDF here

Open in new window


Also, in the  printSheetsToPDF() routine, line 56-59 should read:

    'print Selected sheets, as needed
    If bPrint Then
        wkb.PrintOut
    End If

Open in new window


I also tested the emailing and it worked correctly.  I added a few lines to ensure there were recipients.  Note, ONE email goes to all the recipients with them on the TO list.  If you want to send individual emails, then you need to include the code in a loop for each recipient, one by one (let me know if you need assistance with that).

Please see attached.

Dave
Price-List-03-04-12-r2.xlsm
0
 

Author Closing Comment

by:shawks
Comment Utility
Thanks for all your help that works exactly as I had hoped.

With regard to the email recipients - they are all in one company so in theory they should be fine as they are.

The Spreadsheet is dynamically linked to a SQL database and I am going to look at the potential that this has for sending to different companies by moving the customer number in Discount Structure Control D8 to the next number in a list (generated from the SQL Database) but I suspect the challenge will be that I need to wait for the SQL data to refresh between each customer to ensure the variable data is correct in each before the email is created - anyway thats for another day!!

Thanks Again for a quick and excellent solution.

Steve
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now