Need Macro to Send Excel file as PDF from Outlook to Multiple Users

[dwebe113]

I currently have a spreadsheet setup on a Macro to send & distribute a message from an 2007 Excel file to multiple users through Microsoft Outlook 2007. It is currently setup to send as an attachment. I need to find a way to have this file be sent as a PDF file. I know you can save Excel as PDF's so there must be a way to send them & attach them to as a PDF.

Any help would be appreciated.

 

[Domenic]

For Excel 2007 and later versions, the ExportAsFixedFormat method can be used. Try something like this...

Sub test()

    TempFile = "C:\Users\Domenic\Desktop\temp.pdf" 'path and name of temp file to be saved

    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFile 'save activeworkbook as a PDF file
    
    'Your code here to attach PDF file to an email
    
    Kill TempFile 'delete the temp PDF file
    
End Sub

 

[dwebe113]

For Excel 2007 and later versions, the ExportAsFixedFormat method can be used. Try something like this...

Sub test()

    TempFile = "C:\Users\Domenic\Desktop\temp.pdf" 'path and name of temp file to be saved

    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFile 'save activeworkbook as a PDF file
    
    'Your code here to attach PDF file to an email
    
    Kill TempFile 'delete the temp PDF file
    
End Sub

Domenic,

Thanks for the reply. I think that would work, but what exactly is the code to attach the PDF file to email? Here's our code for just attaching a regular Excel Spreadsheet to Outlook 2007 Email.

Sub SendEmail_DailyPlan()





' ********************************************************************************
' Initialize Variables and Format Date for Worksheet Title
' ********************************************************************************




Sheets("Daily_Plan").Select
ReportYear = Year(Range("a1"))
ReportDay = Right("00" & Day(Range("a1")), 2)
ReportMonth = Right("00" & Month(Range("a1")), 2)
ReportHour = Right("00" & Hour(Range("a1")), 2)
ReportMinute = Right("00" & Minute(Range("a1")), 2)


ReportDate = ReportYear & "-" & ReportMonth & "-" & ReportDay & " " & ReportHour & "" & ReportMinute
Department = Sheets("Daily_Plan").Range("A2")
ReportType = Range("B1")




Title = Trim(Department & " " & ReportType & " " & ReportDate)
'MsgBox Title


' *******************************************************************************
' Create eMail List Array
' *******************************************************************************


Sheets("email").Select


' Empty previous email Addresses
For n = 1 To 500
    eMailAddress(n) = ""
    Next n
    
' Find Department Column
For nCol = 1 To 10
    If Cells(1, nCol) = Department Then
        Exit For
        End If
    Next nCol
    If nCol = 10 Then MsgBox "Department Not Found"


' ********************************************************************************
' Select how far down the email list to send.
' ********************************************************************************




HowManyEmails = Cells(10, 1)






'MsgBox "HowManyEmails=" & HowManyEmails
'End


' *******************************************************************************
' Load eMail addresses into array
' *******************************************************************************


eMailAddress(1) = Cells(6, nCol)  ' This cell contains the email address for SharePoint


If HowManyEmails = 0 Then GoTo DoNotAddEmailsToList
For nRow = 7 To HowManyEmails + 6
    IsValidEmail = 0
    If Cells(nRow, nCol) = "" Then Exit For
    For nAddressCheck = 1 To 100
        If Mid(Cells(nRow, nCol), nAddressCheck, 1) = "" Then Exit For
        If Mid(Cells(nRow, nCol), nAddressCheck, 1) = "@" Then
            IsValidEmail = 1
            Exit For
            End If
        Next nAddressCheck
    If IsValidEmail = 1 Then
        eMailAddress(nRow - 5) = Cells(nRow, nCol) 'Load individual names
        Else
            eMailAddress(nRow - 5) = Cells(nRow, nCol) & "@newpagecorp.com"
        End If
    'MsgBox nRow - 4 & "  emailAddress=" & eMailAddress(nRow - 4)
    Next nRow
DoNotAddEmailsToList:
'MsgBox eMailAddress(1)
'End


' *******************************************************************************
' Send Emails
' *******************************************************************************






ActiveWorkbook.Worksheets("Daily_Plan").Copy
If Val(Application.Version) = 11 Then
    ActiveWorkbook.SaveAs Title
    Else: ActiveWorkbook.SaveAs Title, xlAddIn8
    End If


'Worksheets("Daily_Plan").Copy


On Error GoTo BadEmail


ActiveWorkbook.SendMail Recipients:=Array(eMailAddress), Subject:=Title
ActiveWorkbook.Close savechanges:=False
MsgBox Title & " was Delivered to " & nRow - 6 & " email addresses and filed in SharePoint"
GoTo BottomOfSub




BadEmail:
MsgBox Title & "delivery was not possible due to email error.  SharePoint file was saved on drive."
ActiveWorkbook.Close savechanges:=True


BottomOfSub:












End Sub

 

[Sundar M]

Hi buddy,

Could you please give the idea to create a macro. It should be copy a subject from the excel sheet and find in the outlook and create a mail pdf and attached file in the mail. After it has done... again it has to go to next row no and has to do the same. For this i need to follow if with loop condn. i am not familiar with at all. It would be much appreciatable if you help me to finish this..