VBA Kod Yardımı

[Mehmet Sait]

Merhaba,

Aşağıda ki kod mantığını kullanarak sayfaları PDF yapıp mail gönderebiliyorum.
Ancak aynı mantık ile birde excel formatında göndermekte istiyorum.
İlgili kodlar aynı mantıkla excel formatına çevrilebilir mi ?

Sub Raporlama()

Application.ScreenUpdating = False

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Dim nesne As Object
  Dim yol As String, masaustuyolu As String
  Dim sor: Dim m As Long: Dim pdff As String: Dim pdff2 As String
  Dim altklas As String, s1 As Worksheet
Set s1 = Sheets("Raporlama")
Dim s2 As Worksheet
Dim st
Dim arm As Range, df As String
If s1.[B11] <> "" Then
df = Split(Trim(s1.[B11].Value), " ÜRETİM")(0)
st = MsgBox(df & " Üretim Değerlendirme Güncellenmesi yapılsın mı?", vbYesNo)
If st = vbYes Then
Set s2 = Sheets("Üretim Değerlendirme")
s2.Activate
Set arm = s2.Rows("2:2").Find(df, , xlValues, xlPart, xlByRows, , False, , False)
If Not arm Is Nothing Then
arm.Select
'*************************************************'
Call Sheets("Üretim Değerlendirme").kopru
'*************************************************'
s1.Activate
Else
st = MsgBox("Güncelleme yapılamadı işlem sonlansınmı?", vbYesNo)
If st = vbNo Then Exit Sub
End If
End If: End If
If WorksheetFunction.CountA(s1.Range("AA1:AA7")) <> 7 Then
MsgBox "Rapor Ayını Yenileyiniz"
Exit Sub
End If

If s1.[B11] = "" Then
s1.[B11].Select
MsgBox "Rapor seçiniz"
Exit Sub
End If
'...............................................

'..................................................................
Set nesne = CreateObject("Scripting.FileSystemObject")
masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")

yol = masaustuyolu & "\" & Format(Date, "yyyy") & " Üretim Raporları"
If nesne.FolderExists(yol) = False Then nesne.CreateFolder yol

altklas = Format(Date, "dd.mm.yyyy") & " " & " - " & [B11]
yol = yol & "\" & altklas
If nesne.FolderExists(yol) = False Then nesne.CreateFolder yol
    
sayfalar = Array("Üretim Veri Analizi", "Dönemsel Karşılaştırma", "Aylık", "Ürün ve Marka Bazında", _
"Aylık Performans", "Hurda İcmali", "Üretim Değerlendirme")

For m = 0 To UBound(sayfalar)
pdff = Trim(s1.Range("AA" & m + 1).Text) & ".pdf"
Sheets(sayfalar(m)).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=yol & "\" & pdff, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

'------------------------------------------
Sheets(sayfalar(m)).Protect Password:="699"
'------------------------------------------
 
 pdff2 = pdff2 & pdff
Next
Range("AA1:AA7") = ""
sor = MsgBox("Dosyalar " & vbCrLf & yol & vbCrLf & "Klasörüne kaydedildi" & vbCrLf & _
"MAİL GÖNDERİLSİNMİ?", vbYesNo)
If sor = vbNo Then Exit Sub
If Range("C2") = "" Then MsgBox "Mail Adresi Yazınız": [C2].Select: Exit Sub
  Title = Range("B11")
  Kime = Range("C2")
  Bilgi = Range("C3")
  'Gizli = Range("C4")
  Mesaj = Range("C5")
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

With OutlApp.CreateItem(0)
 
    .Subject = Title
    .To = Kime
    .CC = Bilgi ' bilgi olarak kime
    .BCC = Gizli
    .Body = Mesaj
    '"....," & vbLf & vbLf _
     '     & " ....." & vbLf & vbLf _
      '    & "...." & vbLf _
       '   & [C81] & vbLf _
        '  & [C83] & vbLf & vbLf
    
    
For t = 0 To UBound(Split(pdff2, ".pdf")) - 1
.Attachments.Add yol & "\" & Split(pdff2, ".pdf")(t) & ".pdf"
Next
On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail gonderilemedi", vbExclamation, " "
    Else
      MsgBox " E-mail gonderildi... İşleminiz tamamlanmıştır..! ", vbInformation, " MSC "
    End If
    On Error GoTo 0
 
  End With

Application.ScreenUpdating = True

If IsCreated Then OutlApp.Quit
  Set OutlApp = Nothing

Sheets("anamenu_raporlar").Select
ActiveSheet.Protect Password:="340"
Range("A1").Select
Range("J7").Select
ActiveWindow.Zoom = 70


End Sub

Yardımlarınız için teşekkür ederim.