Aktif Excel Sayfasını xlsx formatında Mail Atma

[walabi]

Merhaba,

Kullanmış olduğum xlsm formatındaki excel kitabımın aktif sayfasını xlsx formatında mail atmak istiyorum. İnternet üzerinden aşağıda bulduğum iki farklı kod bloğu var. İkinci kod bloğuna ilk kod bloğundaki özelliği nasıl kazandırabilirim. İkinci kod bloğunda maile eklenen excel kitabının adı değiştirilebiliyor. Ancak xlsx formatına döndürerek excel kitabını göndermek istiyorum. Bunu nasıl yapabilirim.

Bir de şunu sormak istiyorum. İlk kod bloğunda .SendMail Recipients:=Array kod kısmı nasıl bir işlev yapmakta. Çok kısa bir kod parçası ama xlsm formatındaki çalışma kitabımın aktif sayfasını xls formatında kitap1 adıyla gönderebilmekte.

Sub MailAt()
Sheets("Günlük Rapor").Activate
ActiveSheet.Copy 'aktif sayfayı kopyalar
With ActiveWorkbook
         .SendMail Recipients:=Array("deneme@deneme.com", "deneme@deneme.com", "deneme@deneme.com"), _
          Subject:="Teknik Servis Günlük Rapor"
        
         .Close SaveChanges:=False 'aktif sayfayı kaydetmeden kapatır
        

End With
MsgBox "Mail Gönderildi"
End Sub

Sub Mail_Aktif_Sayfa()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 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

    ' Next, copy the sheet to a new workbook.
    ' You can also use the following line, instead of using the ActiveSheet object,
   ' if you know the name of the sheet you want to mail :
    ' Sheets("Sheet5").Copy
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    ' Determine the Excel version, and file extension and format.
    With Destwb
        If Val(Application.Version) < 12 Then
            ' For Excel 2000-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            ' For Excel 2007-2010, exit the subroutine if you answer
            ' NO in the security dialog that is displayed when you copy
            ' a sheet from an .xlsm file with macros disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "You answered 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 ' 52
                    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

    ' You can use the following statements to change all cells in the
   ' worksheet to values.
        'With Destwb.Sheets(1).UsedRange
            '.Cells.Copy
            '.Cells.PasteSpecial xlPasteValues
            '.Cells(1).Select
        'End With
       'Application.CutCopyMode = False

    ' Save the new workbook, mail, and then delete it.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = Sheets("GÜNLÜK RAPOR").Range("F1") & " " & " Tarihli Teknik Servis Günlük Rapor" '& " " & Sourcewb.Name
            

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

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
       ' Change the mail address and subject in the macro before
       ' running the procedure.
        With OutMail
            .To = "deneme@deneme.com"
            .CC = "deneme@deneme.com"
            .BCC = ""
            .Subject = "Teknik Servis Günlük Rapor"
            .Body = "Teknik Servis günlük rapor bilgileri ektedir."
            .Attachments.Add Destwb.FullName
            ' You can add other files by uncommenting the following statement.
            '.Attachments.Add ("C:\test.txt")
            ' In place of the following statement, you can use ".Display" to
            ' display the mail.
            .Send
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    ' Delete the file after sending.
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub