UserForm üzerinden mail göndermek.

[RDFLCN]

Merhabalar

Userform'a eklenen filtrele butonuna bastığımda sayfa filtreleniyor istediğim gibi. Filtre butonuna bastıktan sonra aktif sayfayı mail ile göndermek istiyorum yardımcı olabilir misiniz ?

 

[ÖmerFaruk]

Forumda arama yapabilirsiniz. Bolca örnek var. Altın üye olarak dosyalara da direkt erilebilirsiniz.

 

[RDFLCN]

Forumda arama yapabilirsiniz. Bolca örnek var. Altın üye olarak dosyalara da direkt erilebilirsiniz.

Bulamadım bir tane örnek atabilir misiniz konuyu açmadan önce bakmıştım ama 1 2 tane buldum indirdim ama çalışmadı.

 

[ÖmerFaruk]

Bulunacak örnek çalışmalar %99 olasılıkla kendine has çalışmadır.
Sayfa adı, başvurular, içerik, istekler farklıdır.

VBA ile yapılan çözümler hazır takım elbise gibi değil, biraz terzi usulüdür.

 

[mustafakoker]

Merhabalar

Kodları kendi sayfa isimlerine göre revize etmelisin
Excel Çalışma Kitabı olarak mail gönderir.

Sub AktifSayfaMailGonder()

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
.Calculation = xlCalculationManual

End With

Set Sourcewb = ThisWorkbook

ActiveSheet.Copy
ActiveSheet.DrawingObjects.Delete 'aktif sayfadaki buton ve nesneleri Resimleri Siler
Set Destwb = ActiveWorkbook

With Destwb
'FileExtStr = ".xlsb": FileFormatNum = 50 ' İkili Çalışma Kitabı dosyasıdır.
'FileExtStr = ".xlsx": FileFormatNum = 51
FileExtStr = ".xls": FileFormatNum = 56
End With
SheetName = ActiveSheet.Name

TempFilePath = Environ$("temp") & "\"
TempFileName = ActiveSheet.Name & "" & Format(Now, "dd.mm.yyyy")

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

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.Display
.To = Range("C7") '1.MAİL ADRESİ GÖNDERİLECEK MAİL ADRESİNİN BULUNDUĞU HÜCRE
' .CC = "MUSTAFAKOKER53@HOTMAIL.COM"
.BCC = ""
.Subject = "Sayın :" & Range("C2") & " Cari Hesap Ekstreniz Hk:" & " " & Format(Date, "dd.mm.yyyy") 'konu satırı

.HTMLBody = " <h4><br><font size=3 color =blue face=Roboto style=border 3px solid = DodgerBlue >Sayın: " & Range("c2") & "<br><br></h4></font>" & _
"<h5>xxxxxxxxxxxxxxxxxx MAKİNA SAN.TİC. A.Ş. tarafından gönderilen bu mail ile sizden mutabık olup olmadığınızla ilgili </h5></br>" & _
"<h5>geri dönüş bekliyoruz. Cari Hesap Ekstreniz ekte bilginize sunulmuş olup, kontrol etmeniz ve </h5></br>" & _
"<H5><font size=3 color =Red=Roboto style=border 3px solid = DodgerBlue >ödeme hakkında bilgi vermeniz önemle rica olunur.</h5>" & _
"<TABLE BGCOLOR=#EF0919 BORDER=2 WIDTH=400><TD ALIGN=LEFT><FONT COLOR=#F5F5F5> <h4> Cari Hesap Bakiyeniz : " & Range("b1") & " TL" & "</font></TD></TABLE>" & _
"<br>" & _
"<h4>Hesap İsmi: xxxxxxxxxxxxxxxxxxxxxxx MAKİNA SAN.TİC. A.Ş.</h4></br>" & _
"<TABLE BGCOLOR=#461B7E BORDER=2 WIDTH=850><TD ALIGN=CENTER><FONT COLOR=#F5F5F5> <h4> (TL)-BANKA HESAP BİLGİLERİMİZ</font></TD></TABLE>" & _
"<TABLE BGCOLOR=E0E0E0 BORDER=2 WIDTH=850>" & _
"<TR><TH>Banka İsmi<TH>Şube İsmi /Şube Kodu<TH>Hesap Kodu<TH>İban No</TH></TR>" & _
"<TR><TD ALIGN=LEFT>xxxxxxxxxxxxxxx BANKASI A.S.</TD>" & _
"<TD ALIGN=LEFT>xxxxxxxxxxxxxxxxxxxx SANAYI SUBE</TD>" & _
"<TD ALIGN=CENTER>xxxxxxxxxxxxxx</TD>" & _
"<TD ALIGN=LEFT>TR32 xxxxxxxxxxxxxxxxxxx</TD>" & _
"</TD></TR>" & _
"<TR><TD ALIGN=LEFT>xxxxxxxxxxxxxxx BANKASI A.S.</TD>" & _
"<TD ALIGN=LEFT>xxxxxxxxxxxxxx SANAYI SUBE</TD>" & _
"<TD ALIGN=CENTER>0000000</TD>" & _
"<TD ALIGN=LEFT>TRxxxxxxxxxxxxxxx</TD>" & _
"</TD></TR>" & _
"<TR><TD ALIGN=LEFT>T.C.xxxxxxxx BANKASI A.S.</TD>" & _
"<TD ALIGN=LEFT>00xxxxxxxxxxxxx SUBESI</TD>" & _
"<TD ALIGN=CENTER>000000002</TD>" & _
"<TD ALIGN=LEFT>TRxxxxxxxxxxxxxxxxxxxx2</TD>" & _
"</TD></TR></TABLE </font> </p> " & .HTMLBody


.Attachments.Add Destwb.FullName
.Send
' .Display
End With
'
On Error GoTo 0
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic

End With

End Sub

 

[RDFLCN]

@mustafakoker

Hocam kodu modül sayfasına ekledim çalışıyor Elinize Sağlık.


Bu ekranlar çıkmadan gönderme işlemi yapamaz mıyız ? yada bu ekranlardan kurtulma şansımız yok mu ?




excel içinde bunun gibi göderme seçeneğimiz yada ?



şimdiden teşekkür ederim iyi akşamlar

 

[mustafakoker]

@mustafakoker

Hocam kodu modül sayfasına ekledim çalışıyor Elinize Sağlık.


Bu ekranlar çıkmadan gönderme işlemi yapamaz mıyız ? yada bu ekranlardan kurtulma şansımız yok mu ?


Ekli dosyayı görüntüle 239136

excel içinde bunun gibi göderme seçeneğimiz yada ?

Ekli dosyayı görüntüle 239137

şimdiden teşekkür ederim iyi akşamlar

ALT+F11
üst başlıklarda Tools/Referans
aşağıdaki seçili olanları kendi excel sürümüne göre eklemelisin

 

[RDFLCN]

@mustafakoker Hocam Teşekkür ederim oldu.
Son olarak,

Benim 8 ayrı sayfam var her gün 12.00 belirtilen sayfaları mail olarak göndersin aynı şekilde.

yani sizin vermiş olduğunuz Makro Aktif sayfa değil de belirtilen sayfalarda yapsın ama sayfalar yine ayrı ayrı gidecek.

Şuan,
Application.OnTime Now + TimeSerial(0, 40, ), "gnder"

ile sayfa açıldıktan 40 dk sonra sadece aktif sayfayı gönderiyor.