Hi,

I am successfully using this macro to save a worksheet of my .xlsm workbook as .xls and then send it via email with a predefined body. Now however, I am in dire need of saving the file as PDF, but cant seem to get it done via the regular FileExtStr = ".pdf": FileFormatNum = 17 solution.

any help on this would be much appreciated as I believe it somehow has to do with the way outlook 2010 is attaching it, respectively the seperated var for the file extension.

Sub Mail_ActiveSheet()
'Working in 2000-2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim outMail As Object

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook
    
    If ActiveWorkbook.ActiveSheet.ProtectContents = True Then
        Call ProtectSheet
    End If
    
    'Copy the sheet to a new workbook
    ActiveSheet.Copy Before:=Sheets(1)
        With ActiveSheet
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
        End With
        Application.CutCopyMode = False
    
    ActiveSheet.Copy
    
    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 2000-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                        'FileExtStr = ".pdf": FileFormatNum = 17
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With


    'Change all cells in the worksheet to values if you want
    'With Destwb.Sheets(1).Range("A1:I50")
    '    .Select
    '    .Copy
    '    .PasteSpecial xlPasteValues
    'End With
    'Application.CutCopyMode = False


    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    Set OutApp = CreateObject("Outlook.Application")
    Set outMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        With outMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "daily report"
            .Body = "Kind regards,"
                    
            .Attachments.Add Destwb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Display   '.Send or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
    
    ' Delete the duplicated worksheet and turn off prompts
    Application.DisplayAlerts = False
        With ActiveWorkbook.ActiveSheet
            .Select
            .Delete
        End With
    Application.DisplayAlerts = True
    
    ' protect sheet again
    If ActiveWorkbook.ActiveSheet.ProtectContents = False Then
        Call ProtectSheet
    End If
    
    
    ' Select sourcewb Feeback Summary
    With Sourcewb
        .Sheets("Feedback MTD").Select
    End With
    
    
    ' Clean up
    Set outMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub
ares highlighted in bold are where I suspect the troubles...

Thanks a lot!
A2k