Macro ile mail gönderme hakkında

[Hyperhysv]

merhabalar,

benim daha önce kulandığım bir macro mevcut pdf formatı olarak ilgili maillere gönderim sağlıyor ama ben pdf değil excel formatında göndermesini istiyorum.

kodda nasıl bir değişiklik yapmalıyım.

şimdiden teşekürler

Sub KOD()
    
    'NOT: TOOLS-REFERENCES TIKLA
    'MİCROSOFT OUTLOOK 12.0 İŞARETLİ OLMALI
    
    Yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & ActiveSheet.Name & "_" & Format(Now(), "ddmmyyyy\_hhmm") & ".pdf"
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Yol, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    Dim objOutlook As Object
    Dim objMail As Object
    Dim i As Long, NoA As Long
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
    With objMail
        .To = ""
        .CC = ""
        .Subject = "DENEME" & " " & Format(Now(), "dd mm yyyy\ hh mm")
        .Attachments.Add Yol
        .Save
        .Display
        '.Send
    End With
    
    Set objMail = Nothing
    Set objOutlook = Nothing
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
End Sub

 

[Emir Hüseyin Çoban]

. . .

Tüm excel tablosunu mu göndermek istiyorsunuz yoksa
çalışmanızdaki sadece 1 sayfayı mı.

. . .

 

[Hyperhysv]

sadece 1 sayfasını yani ilk sayfasını

 

[Emir Hüseyin Çoban]

. . .

Şu şekilde deneyiniz..

Sayfa1 de formüller var mı. Ona göre işlem değişir.

Sub KOD()
    
    'NOT: TOOLS-REFERENCES TIKLA
    'MİCROSOFT OUTLOOK 12.0 İŞARETLİ OLMALI
    
    Sheets("Sayfa1").Copy
    yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & ActiveSheet.Name & "_" & Format(Now(), "ddmmyyyy\_hhmm") & ".xlsx"
    ActiveWorkbook.SaveAs Filename:=yol, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close

    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    Dim objOutlook As Object
    Dim objMail As Object
    Dim i As Long, NoA As Long
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
    With objMail
        .To = ""
        .CC = ""
        .Subject = "DENEME" & " " & Format(Now(), "dd mm yyyy\ hh mm")
        .Attachments.Add Yol
        .Save
        .Display
        '.Send
    End With
    
    Set objMail = Nothing
    Set objOutlook = Nothing
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
End Sub

. . .

 

[Hyperhysv]

hüseyin bey formül yok, gayet iyi çalışıyor.

desteğiniz için çok teşekkürler
iyi akşamlar