Excel dosyasını mail olarak gönderme

[pasha22]

Merhaba;
Excel dosyasında yaptığım işlemler bitince kayıt ederek çıkış yaptığımda, bu Excel dosyasını otomatik olarak mail ile belirleyeceğim adrese gönderilmesi için makroya ihtiyacım var.
Saygılarımla.

 

[TEGCreative]

Sub MailGonder()


ActiveWorkbook.Save

ActiveWorkbook.EnvelopeVisible = True

With ActiveWorkbook.MailEnvelope

.Introduction = "Konu" & Chr(13) & Chr(13) & " Konu"

.Item.To = "abcd@hotmail.com"

.Item.CC = " "

.Item.Subject = Date  & " konu" 'Bugün tarihli konu bilgisini başlık olarak yazar

.Item.Send

End With

MsgBox "Mail gönderildi"
End Sub

Merhabalar ; bulduğum bir örneği olduğu gibi yazdım. Bunu Workbook_Close içersine yazdığımızda sorunsuz çalışmalı. Tabii bilgisayarınızda outlook mail ayarlarınız ve outlook mail kurulumunuz tamam olmalı.

 

[Korhan Ayhan]

Alternatif;

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object

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

    On Error Resume Next
    With OutMail
        .to = "abcde@gmail.com"
        .CC = ""
        .BCC = ""
        .Subject = "Bu bir deneme mailidir..."
        .Body = "Merhaba," & Chr(10) & Chr(10) & "Bu bir deneme mailidir..."
        .Attachments.Add ActiveWorkbook.FullName
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[Korhan Ayhan]

Bu da onay ile göndermek için alternatif;

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim OutApp As Object, OutMail As Object, Onay As Byte

    Onay = MsgBox("Dosyayı mail olarak göndermek istiyor musunuz?", vbYesNo, "Uyarı !")
    
    If Onay = vbYes Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
    
        On Error Resume Next
        With OutMail
            .to = "abcde@gmail.com"
            .CC = ""
            .BCC = ""
            .Subject = "Bu bir deneme mailidir..."
            .Body = "Merhaba," & Chr(10) & Chr(10) & "Bu bir deneme mailidir..."
            .Attachments.Add ActiveWorkbook.FullName
            .Send
        End With
        On Error GoTo 0
    
        Set OutMail = Nothing
        Set OutApp = Nothing
    End If
End Sub

 

[pasha22]

çok teşekkür ederim..

 

[alialtiner]

merhaba; banada böyle bişey lazım, makro ile yapamadım. örnek dosya ekleyebilirmisiniz?