Arkadaşlar merhaba;
Ekteki kodları siteden buldum. Çalıştırdığımda C hücresinde ki mail adresini almıyor. Mail gönderilmeden ekranda kalıyor. Sorunu nasıl çözebilirim?
Ekteki kodları siteden buldum. Çalıştırdığımda C hücresinde ki mail adresini almıyor. Mail gönderilmeden ekranda kalıyor. Sorunu nasıl çözebilirim?
Kod:
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
Son düzenleme:
