Arkadaşlar merhaba,
Çalışma çok faydalı olmuş ancak şöyle bir sorun yaşıyorum. Mail gönder dediğim zaman To satırına denk gelen mail adreslerini almıyor. Bu sorunu nasıl çözebilirim.
Yardımınız için şimdiden teşekkür ederim.
Sub Hatırlatma_Mesajı_Gonder()
Application.ScreenUpdating = False
Dim OutApp As Object, OutMail As Object
Dim resim As Object, a As Shape, basla As String, bitir As String
Dim td1 As String, td2 As String, tr1 As String, tr2 As String
Dim htmlmetin As String, strResim As String, r As String
Dim c As String, d As String, b As String, i As Integer, t As String
Sheets("Hatırlatma").Select
For bir = 2 To [A65536].End(3).Row
If Format(Cells(bir, "B"), "dd.mm") = Format(Range("N2"), "dd.mm") Then
basla = "<html><body>"
t = "<table>"
bitir = "</table></body></html>"
tr1 = "<tr>": tr2 = "</tr>"
td1 = "<td>": td2 = "</td>"
htmlmetin = "<B>" & Cells(bir, "A") & "</B>" & ", " & "<br>" & _
"<br><br>"
strResim = "C:\Google Drive\Falcon\Resimler\uyarı.jpg"
r = "<IMG alt='' hspace=0 src='" & strResim & "' align=baseline border=0>"
htmlmetin = basla & t & htmlmetin & r
On Local Error Resume Next
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Cells(bir, "C")
.Subject = "Hatırlatma"
.HTMLBody = htmlmetin
.Display
.Send
End With
Set OutMail = Nothing: Set OutApp = Nothing
Set a = Nothing: Set resim = Nothing
basla = "": bitir = "": td1 = "": td2 = "": tr1 = "": tr2 = ""
htmlmetin = "": strResim = "": r = "": b = "": c = "": d = "": i = Empty
Else: End If
Next bir
Application.ScreenUpdating = True
End Sub
Çalışma çok faydalı olmuş ancak şöyle bir sorun yaşıyorum. Mail gönder dediğim zaman To satırına denk gelen mail adreslerini almıyor. Bu sorunu nasıl çözebilirim.
Yardımınız için şimdiden teşekkür ederim.
Sub Hatırlatma_Mesajı_Gonder()
Application.ScreenUpdating = False
Dim OutApp As Object, OutMail As Object
Dim resim As Object, a As Shape, basla As String, bitir As String
Dim td1 As String, td2 As String, tr1 As String, tr2 As String
Dim htmlmetin As String, strResim As String, r As String
Dim c As String, d As String, b As String, i As Integer, t As String
Sheets("Hatırlatma").Select
For bir = 2 To [A65536].End(3).Row
If Format(Cells(bir, "B"), "dd.mm") = Format(Range("N2"), "dd.mm") Then
basla = "<html><body>"
t = "<table>"
bitir = "</table></body></html>"
tr1 = "<tr>": tr2 = "</tr>"
td1 = "<td>": td2 = "</td>"
htmlmetin = "<B>" & Cells(bir, "A") & "</B>" & ", " & "<br>" & _
"<br><br>"
strResim = "C:\Google Drive\Falcon\Resimler\uyarı.jpg"
r = "<IMG alt='' hspace=0 src='" & strResim & "' align=baseline border=0>"
htmlmetin = basla & t & htmlmetin & r
On Local Error Resume Next
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Cells(bir, "C")
.Subject = "Hatırlatma"
.HTMLBody = htmlmetin
.Display
.Send
End With
Set OutMail = Nothing: Set OutApp = Nothing
Set a = Nothing: Set resim = Nothing
basla = "": bitir = "": td1 = "": td2 = "": tr1 = "": tr2 = ""
htmlmetin = "": strResim = "": r = "": b = "": c = "": d = "": i = Empty
Else: End If
Next bir
Application.ScreenUpdating = True
End Sub