Soru Sayfadaki Aktif Tabloyu Mail İle Gönderme

[ercan_bora]

Selamlar,

Bir sipariş formum var ve bunu müşteri doldurduğunda en son Proforma sayfasına Mail İle Gönder diyince belirlenen mail adresine içeriği mail atsın istiyorum.

İnternette buldum birkaç kaynak fakat bir türlü mail atmadı.
http://ehlideyazar.blogspot.com/2018/09/excel-sayfasn-mail-gonderme.html gibi.

Örnekteki Proforma sayfasını ercanbora@gmail.com adresine göndermek için ne gibi bir makro yazmak lazım. Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

Yenileme.xlsm dosyasını indir - download

Yenileme.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s2.dosya.tc

 

[EmrExcel16]

Merhaba , istenilen "Proforma" adındaki sayfayı mail eki yapıp göndermek ise ,Outlook ile aşağıdaki kodlar yapabilir.

Excel dosyanızın kod bölümüne bir modül ekleyip aşağıdaki kodları yapıştırın.

Option Explicit

Sub Proforma_Sayfasini_Mail_at()
    
    Dim FilePath As String, FileName As String, OutApp As Object, OutMail As Object, WshShell As Object
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    Set WshShell = CreateObject("WScript.Shell")
    
    ThisWorkbook.Sheets("Proforma").Copy
 
    FilePath = WshShell.SpecialFolders("Desktop") + "\"
    FileName = "Proforma " & Format(Now, "dd-mmm-yy h-mm-ss")
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    ActiveWorkbook.Sheets("Proforma").Shapes.Range(Array("Button 1")).Delete
    ActiveWorkbook.SaveAs FilePath & FileName
    With OutMail
        .To = "ercanbora@gmail.com"
        .CC = "test@hotmail.com"
        .Subject = FileName
        .Body = "Merhaba ," & Chr(13) & Chr(13) & "Bilginize.." & Chr(13) & Chr(13) & "İyi calismalar..."
        .Attachments.Add ActiveWorkbook.FullName
        .Display
        '.send 'mail gonderilsin isteniyorsa en basindaki tirnagi kaldir
    End With
    ActiveWorkbook.Close SaveChanges:=False
 
    Kill FilePath & FileName & ".xlsx"
    
    Application.ScreenUpdating = True
End Sub

 

[ercan_bora]

Allah razı olsun kardeşim, gayet güzel olmuş....

 

[EmrExcel16]

Allah razı olsun kardeşim, gayet güzel olmuş....

Rica ederim , Allah ( c.c. ) cümlemizden razı olsun ,iyi çalışmalar.