save sheets as new file and Attach to e mail.

[tekken]

Hi

I have this code to save active sheets as a new file and add it to mail
have tried too change this so that it stores as xlsx file and not PDF but can not quite figure it out, can anyone help me?

Sub create_and_email_pdf()

 
Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
CurrentMonth = ""
 
' *****************************************************
 
    EmailSubject = ActiveSheet.Range("R4")
    OpenPDFAfterCreating = False
    AlwaysOverwritePDF = False
    DisplayEmail = True
    Email_To = ""
    Email_CC = ""
    Email_BCC = ""
            
' ******************************************************
     
    'Prompt for file destination
    With Application.FileDialog(msoFileDialogFolderPicker)
         
        If .Show = True Then
         
            DestFolder = .SelectedItems(1)
             
        Else
         
            MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
                 
            Exit Sub
             
        End If
         
    End With
 
    'Current month/year stored in C8 (this is a merged cell)
    CurrentMonth = Mid(ActiveSheet.Range("C8").Value, InStr(1, ActiveSheet.Range("C8").Value, " ") + 1)
     
    'Create new PDF file name including path and file extension
    PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Range("R4") _
                & "_" & CurrentMonth & ".pdf"
 
    'If the PDF already exists
    If Len(Dir(PDFFile)) > 0 Then
     
        If AlwaysOverwritePDF = False Then
         
            OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
         
            On Error Resume Next
            'If you want to overwrite the file then delete the current one
            If OverwritePDF = vbYes Then
     
                Kill PDFFile
         
            Else
     
                MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
                 
                Exit Sub
         
            End If
 
        Else
         
            On Error Resume Next
            Kill PDFFile
             
        End If
         
        If Err.Number <> 0 Then
         
            MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
                 
            Exit Sub
         
        End If
             
    End If
    
 
    'Create the PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=OpenPDFAfterCreating
 
    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
         
    'Display email and specify To, Subject, etc
    With OutlookMail
         
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject & CurrentMonth
        .Attachments.Add PDFFile
                 
        If DisplayEmail = False Then
             
            .Send
             
        End If
         
    End With
     
  
End Sub