hello,
I'm sending mail with codes.
font size 10, how do you make the color blue.
I would ask for your help.
Sincerely,
Eason
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub API_ile_EMail_YollaPARA()
Dim Email As String, Konu As String, Mesaj As String, URL As String, i As Integer
For i = 2 To Range("a65536").End(3).Row
Email = Cells(i, 4) ' mail adresinin adresini saptayalım
Konu = "*** HATIRLATMA *** altında Banknot kalmıştır." 'mail konusunu belirleyelim
SendKeys ("^~") 'Mesaj gövdemizi hazırlayalım
Mesaj = "" 'Kesinlikle olmalı olmazsa bütün mailler alt alt agelir.
Mesaj = Mesaj & "Merhaba," & vbCrLf & vbCrLf ' & vbCrLf & vbCrLf İKİ SATIR BOŞLUK ANLAMINA GELİYOR.
Mesaj = Mesaj & Cells(i, 2) & " " & Cells(i, 3) & " " & vbCrLf & vbCrLf 'ATM ID VE ADI
Mesaj = Mesaj & " altında Banknot kalmıştır. Lütfen para ikmali yapınız." & vbCrLf & vbCrLf & vbCrLf
Mesaj = Mesaj & "Kayıt numarası: " & Cells(i, 1) & vbCrLf & vbCrLf 'KAYIT NUMARASINI GETİR DENEMEK
Mesaj = Mesaj & "Syg," & vbCrLf
Mesaj = Mesaj & "İyi çalışmalar." & vbCrLf & vbCrLf
Mesaj = Mesaj & "DOC" & vbCrLf
Mesaj = Mesaj & "T: 123 45 69" & vbCrLf
Mesaj = Mesaj & "T: (0965) 123 45 69" & vbCrLf & vbCrLf & vbCrLf
Mesaj = Mesaj & "Not: Mail tarafınıza ulaştığında yukarıda bildirmiş olduğumuz konuyla ilgili müdahale yapılmış ise lütfen bu maili dikkate almayınız." & vbCrLf
Konu = Application.WorksheetFunction.Substitute(Konu, " ", "%20") 'Boşlukları html mantığının alayacağı şekle dönüştürelim
Mesaj = Application.WorksheetFunction.Substitute(Mesaj, " ", "%20")
Mesaj = Application.WorksheetFunction.Substitute(Mesaj, vbCrLf, "%0D%0A") 'Satır boşluk verdirmeyi de dönüştürelim (hex) ' Create the URL
URL = "mailto:" & Email & "?Subject=" & Konu & "&body=" & Mesaj
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus 'API 'miz sayesinde sorgusuz onaysız mail gönderelim
Application.Wait (Now + TimeValue("0:00:01")) 'Mailler bir zaniye arayla gönderilsin
SendKeys ("^~") 'Mesajımızı sendkeys ile tıklatmış gibi gönderelim, bitsin gitsin
Next i
MsgBox Range("a65536").End(3).Row - 1 & " Adet mail gönderilmiştir", vbInformation, "Ersoy ALAN"
End Sub
I'm sending mail with codes.
font size 10, how do you make the color blue.
I would ask for your help.
Sincerely,
Eason
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub API_ile_EMail_YollaPARA()
Dim Email As String, Konu As String, Mesaj As String, URL As String, i As Integer
For i = 2 To Range("a65536").End(3).Row
Email = Cells(i, 4) ' mail adresinin adresini saptayalım
Konu = "*** HATIRLATMA *** altında Banknot kalmıştır." 'mail konusunu belirleyelim
SendKeys ("^~") 'Mesaj gövdemizi hazırlayalım
Mesaj = "" 'Kesinlikle olmalı olmazsa bütün mailler alt alt agelir.
Mesaj = Mesaj & "Merhaba," & vbCrLf & vbCrLf ' & vbCrLf & vbCrLf İKİ SATIR BOŞLUK ANLAMINA GELİYOR.
Mesaj = Mesaj & Cells(i, 2) & " " & Cells(i, 3) & " " & vbCrLf & vbCrLf 'ATM ID VE ADI
Mesaj = Mesaj & " altında Banknot kalmıştır. Lütfen para ikmali yapınız." & vbCrLf & vbCrLf & vbCrLf
Mesaj = Mesaj & "Kayıt numarası: " & Cells(i, 1) & vbCrLf & vbCrLf 'KAYIT NUMARASINI GETİR DENEMEK
Mesaj = Mesaj & "Syg," & vbCrLf
Mesaj = Mesaj & "İyi çalışmalar." & vbCrLf & vbCrLf
Mesaj = Mesaj & "DOC" & vbCrLf
Mesaj = Mesaj & "T: 123 45 69" & vbCrLf
Mesaj = Mesaj & "T: (0965) 123 45 69" & vbCrLf & vbCrLf & vbCrLf
Mesaj = Mesaj & "Not: Mail tarafınıza ulaştığında yukarıda bildirmiş olduğumuz konuyla ilgili müdahale yapılmış ise lütfen bu maili dikkate almayınız." & vbCrLf
Konu = Application.WorksheetFunction.Substitute(Konu, " ", "%20") 'Boşlukları html mantığının alayacağı şekle dönüştürelim
Mesaj = Application.WorksheetFunction.Substitute(Mesaj, " ", "%20")
Mesaj = Application.WorksheetFunction.Substitute(Mesaj, vbCrLf, "%0D%0A") 'Satır boşluk verdirmeyi de dönüştürelim (hex) ' Create the URL
URL = "mailto:" & Email & "?Subject=" & Konu & "&body=" & Mesaj
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus 'API 'miz sayesinde sorgusuz onaysız mail gönderelim
Application.Wait (Now + TimeValue("0:00:01")) 'Mailler bir zaniye arayla gönderilsin
SendKeys ("^~") 'Mesajımızı sendkeys ile tıklatmış gibi gönderelim, bitsin gitsin
Next i
MsgBox Range("a65536").End(3).Row - 1 & " Adet mail gönderilmiştir", vbInformation, "Ersoy ALAN"
End Sub
