Solved

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

Posted on 2012-04-04
6
300 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
6 Comments
 
LVL 42

Expert Comment

by:dlmille
ID: 37805973
>>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
ID: 37806577
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 42

Expert Comment

by:dlmille
ID: 37806655
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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:shawks
ID: 37807055
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 42

Accepted Solution

by:
dlmille earned 500 total points
ID: 37807156
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
ID: 37807589
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

Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
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.

717 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