Option Explicit Function Send_Mail(mailto As String) Dim iMsg As Object Dim iConf As Object Dim strbody As String Dim Flds As Variant Set iMsg = CreateObject("CDO.Message") Set iConf = CreateObject("CDO.Configuration") iConf.Load -1 Set Flds = iConf.Fields With Flds .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Email@gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "******" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Update End With With iMsg Set .Configuration = iConf .To = mailto .From = """Othman"" " .Subject = "Medical Supply" .CreateMHTMLBody ThisWorkbook.Path & "\test.html" .Send End With End Function Sub mas() On Error Resume Next Dim n As Integer For n = 2 To 31 If Range("b" & n & "").Value = "" And Date - Range("a" & n & "").Value > 14 Then If Range("c" & n & "").Value <> "" Then Kill ThisWorkbook.Path & "\test.html" generatehtml (n) Send_Mail (Range("c" & n & "").Value) Range("d" & n & "").Value = "Êã ÇáÅÑÓÇá" End If End If Next n MsgBox "Êã ÅÑÓÇá ÌãíÚ ÇáÑÓÇÆá" End Sub Function generatehtml(rw As Integer) Dim fs As Object Dim A As Object Dim FileName As String FileName = ThisWorkbook.Path & "\test.html" Set fs = CreateObject("Scripting.FileSystemObject") Set A = fs.CreateTextFile(FileName, True) A.WriteLine ("
ÚÒíÒí : " & Range("F" & rw & "").Value & "
äÝíÏ ÓíÇÏÊßã ÚáãÇ ÈÃä :
ÇáãÚÇãáÉ ÑÞã : " & Range("E" & rw & "").Value & " æÇáãÄÑÎÉ ÈÊÇÑíÎ : " & Format(Range("a" & rw & "").Value, "yyyy/mm/dd dddd") & " ãÊÃÎÑÉ æÊÓÊæÌÈ ÇáÑÏ
åÐÇ ááÚáã æÇÊÎÇÐ ÇááÇÒã
ãÚ ÊÍíÇÊ :
ÇÓã ÔÑßÊß
") A.Close End Function