e-mailing PDFs

[Michael99]

Hello,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I am hoping someone can help me with some simple code to automate what is a time consuming manual process. <o></o>
<o></o>
I am using Excel 2007 and have a file with over 100 worksheets. What I would like is a macro to individually e-mail each sheet as a PDF to the address in cell C13. It would also be great if it could prompt the user for the subject line to be used in the e-mails (one prompt in the beginning, then use the input text as the subject for all the e-mails). <o></o>
<o></o>
Thank you in advance!<o></o>

 

[nehpets12]

Have a look at cutepdf this will help convert excel sheets into pdf format

 

[Michael99]

Thanks, but the issue I am having is not converting Excel into PDFs (that is built right into Excel 2007), it is the process of automating the conversion and e-mail.

 

[jc.021286]

I have something that does this at the moment,

You will need to update it a bit. How I currently have it set is that the first page is a reference page with all the data and the 2nd sheet uses offset formulas and concatenates to construct a written document.

the code:

Sub SendDocumentByEmail()
'
'If the user is using Excel 2003 it will send an excel sheet to print and sign
'However, if the user is using 2007 (#12) or greater, it will convert the file to a PDF and send
'
        If Val(Application.Version) < 12 Then
            Call SendExcelSheetThroughEmail
        Else
            Call SendTorrentOfEmails
        End If

End Sub
Private Sub SendExcelSheetThroughEmail()
'
'Dimensions of email sending program
Dim myEmail As Object
Dim myEmailNS As Object
Dim myEmailMessage As Object
'
'Dimensions to loop through emails and to save new files as .pdf
Application.DisplayAlerts = False
Dim names As Integer, i As Integer, TheFileName As String, TheFileLocation As String
Dim a, b, c As String
    names = Application.WorksheetFunction.CountA(Sheets("Ref").Columns(4)) - 2
    TheFileLocation = Cells(2, 2) & "\"
    TheFileName = Cells(3, 2)
'
'Check Excel Version
    'Already been done in the Call Function
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
'
'Repeat for every person
'Transform the email file to a .xls
For i = 0 To names
'
    Set myEmail = CreateObject("Outlook.Application")
    Set myEmailNS = myEmail.GetNamespace("MAPI")
    Set myEmailMessage = myEmail.CreateItem(0)
    Sheets("Ref").Cells(14, 2) = i
    a = Sheets("Ref").Cells(16, 4).Offset(Cells(14, 2), 0)
    b = Sheets("Ref").Cells(4, 2)
    c = Sheets("Ref").Cells(5, 2)
    If a = "" Then Exit Sub
    Sheets("Email").Copy
'''''''''''''''''''''''''''''
    Cells.Copy
    Cells(1, 1).Select
    ActiveCell.PasteSpecial Paste:=xlPasteValues
'''''''''''''''''''''''''''''
'Save copy as xls now
    ActiveWorkbook.SaveAs Filename:= _
    TheFileLocation & TheFileName & FileExtStr, FileFormat:=FileFormatNum
    ActiveWindow.Close
'
'Construct the email
    myEmailMessage.To = a
    myEmailMessage.Subject = b
    myEmailMessage.Body = c
    myEmailMessage.Attachments.Add TheFileLocation & TheFileName & FileExtStr 'adds attachment to email
    myEmailMessage.Send
'
    Set myEmail = Nothing
    Set myEmailNS = Nothing
    Set myEmailMessage = Nothing
Next i
End Sub

Private Sub SendTorrentOfEmails()
'
'Dimensions of email sending program
Dim myEmail As Object
Dim myEmailNS As Object
Dim myEmailMessage As Object
'
'Dimensions to loop through emails and to save new files as .pdf
Application.DisplayAlerts = False
Dim names As Integer, i As Integer, TheFileName As String, TheFileLocation As String
Dim a, b, c As String
    names = Application.WorksheetFunction.CountA(Sheets("Ref").Columns(4)) - 2
    TheFileLocation = Cells(2, 2) & "\"
    TheFileName = Cells(3, 2)
'
'
'Repeat for every person
'Transform the email file to a .pdf
For i = 0 To names
'
    Set myEmail = CreateObject("Outlook.Application")
    Set myEmailNS = myEmail.GetNamespace("MAPI")
    Set myEmailMessage = myEmail.CreateItem(0)
    Sheets("Ref").Cells(14, 2) = i
    a = Sheets("Ref").Cells(16, 4).Offset(Cells(14, 2), 0)
    b = Sheets("Ref").Cells(4, 2)
    c = Sheets("Ref").Cells(5, 2)
    If a = "" Then Exit Sub
    Sheets("Email").Copy
'''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''
'Save copy as PDF now as you are using Excel 2007-2010
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        TheFileLocation & TheFileName & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
    ActiveWindow.Close
'
'Construct the email
    myEmailMessage.To = a
    myEmailMessage.Subject = b
    myEmailMessage.Body = c
    myEmailMessage.Attachments.Add TheFileLocation & TheFileName & ".pdf" 'adds attachment to email
    myEmailMessage.Send
'
    Set myEmail = Nothing
    Set myEmailNS = Nothing
    Set myEmailMessage = Nothing
Next i
End Sub

On the Reference Page
Cells
B2 = Save location (S:\PDF files\sent files)
B3 = File Name (How to name the sheet (signing sheet))
B4 = email subject line
b5 = Body of the message, use alt enter to have line breaks and construct something nice and all.

B14 is just an offset variable to have the pdf to be emailed, change, names, titles, addresses, dates, etc.
D16 and down has a list of a few dozen email addresses

I've tested and you need to ensure that you have a wait timer of approx 2 secs if sending 100, otherwise the email servers will label you as spam.

You would need to modify this to simply do it for every sheet other then the first...

Let me know how you would need it adjusted and we can go from there.

Note!!!: You MUST have outlook allow for this, or you will get the MOST annoying alert... Outlook > tools > Trust Center > Pragmatic Access = "Never warn..."

jc

 

[Michael99]

Thank you, JC.

I was able to borrow enough of your code to make it work!

 

[jc.021286]

i am glad you got it to work,
jc