Marco To Create PDF Using Specific Sheets & Attach To Outlook Email

Can anyone tell me why my macro isn't working properly?

The following code has been working flawlessly for quite some time but now it won't do as I need it to.

I want the macro to take specific sheets, create a PDF with them and attach the PDF file to an Outlook email. In this case, it's sheets 2, 3, 4 and 8. However, it will only attach the active sheet. I can't figure out why.

Sub SendWorkSheetToPDF()
'Update 20131209
Dim Wb As Workbook
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Set Wb = Application.ActiveWorkbook
FileName = Wb.FullName
xIndex = VBA.InStrRev(FileName, ".")
If xIndex > 1 Then FileName = VBA.Left(FileName, xIndex - 1)
FileName = FileName & "_" + ActiveSheet.Name & ".pdf"
Sheets(Array(2, 3, 4, 8)).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
Addresses = Sheets("TerminalWorkload-Total").Range("aa10").Value
With OutlookMail
.To = Addresses
.CC = ""
.BCC = ""
.Subject = "Terminal Workload Calculator - Mobile/109"
.Body = " "
.Body = "Terminal Workload Calculator - Mobile/109 - Fail to plan... Plan to fail"
.Attachments.Add FileName
.Display
End With
Kill FileName
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

Thanks!

.

Option Explicit

Sub SendWorkSheetToPDF()

Dim Wb As Workbook
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim xIndex As Integer
Dim Addresses As String
On Error Resume Next
Set Wb = Application.ActiveWorkbook

    FileName = Wb.FullName
    
    xIndex = VBA.InStrRev(FileName, ".")
    
        If xIndex > 1 Then FileName = VBA.Left(FileName, xIndex - 1)
        
        FileName = FileName & "_" + ActiveSheet.Name & ".pdf"
        ThisWorkbook.Sheets(Array("Sheet2", "Sheet3", "Sheet4", "Sheet8")).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName
        Set OutlookApp = CreateObject("Outlook.Application")
        Set OutlookMail = OutlookApp.CreateItem(0)
        Addresses = Sheets("Sheet1").Range("A1").Value
        
            With OutlookMail
                .To = Addresses
                .CC = ""
                .BCC = ""
                .Subject = "Terminal Workload Calculator - Mobile/109"
                .Body = " "
                .Body = "Terminal Workload Calculator - Mobile/109 - Fail to plan... Plan to fail"
                .Attachments.Add FileName
                .Display
            End With
            
    Kill FileName
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
    
Sheets("Sheet1").Activate
Sheets("Sheet1").Range("A1").Select
End Sub

Actually, I just noticed something...

It doesn’t appear to have the code that would tell it where the email addresses are listed on one of the sheets. Look at my previous code and you’ll see they are listed in AA10 on a particular sheet.

Can you add that command into the code you offered?

Originally Posted by Logit

.

Option Explicit

Sub SendWorkSheetToPDF()

Dim Wb As Workbook
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim xIndex As Integer
Dim Addresses As String
On Error Resume Next
Set Wb = Application.ActiveWorkbook

    FileName = Wb.FullName
    
    xIndex = VBA.InStrRev(FileName, ".")
    
        If xIndex > 1 Then FileName = VBA.Left(FileName, xIndex - 1)
        
        FileName = FileName & "_" + ActiveSheet.Name & ".pdf"
        ThisWorkbook.Sheets(Array("Sheet2", "Sheet3", "Sheet4", "Sheet8")).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName
        Set OutlookApp = CreateObject("Outlook.Application")
        Set OutlookMail = OutlookApp.CreateItem(0)
        Addresses = Sheets("Sheet1").Range("A1").Value
        
            With OutlookMail
                .To = Addresses
                .CC = ""
                .BCC = ""
                .Subject = "Terminal Workload Calculator - Mobile/109"
                .Body = " "
                .Body = "Terminal Workload Calculator - Mobile/109 - Fail to plan... Plan to fail"
                .Attachments.Add FileName
                .Display
            End With
            
    Kill FileName
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
    
Sheets("Sheet1").Activate
Sheets("Sheet1").Range("A1").Select
End Sub

Thanks, Logit! I will give this a whirl in the morning and let you know if it works for me.

.
Replace this line in the macro of the workbook I attached :

Addresses = Sheets("Sheet1").Range("A1").Value

With this line :

Addresses = Sheets("TerminalWorkload-Total").Range("aa10").Value

Change the sheet names in these two lines to the sheet name where you have the command button to run the macro:

Sheets("Sheet1").Activate
Sheets("Sheet1").Range("A1").Select

If the Command Button is located on Sheet 1 .... don't change it.