Sub GuiMail()
Dim OutApp As Object, OutMail As Object
Dim WB As Workbook, Ash As Worksheet, mailAddress As String, i As Integer, ir As Integer
Dim Rcount As Long, FileName As String, Rnum As Long, strHeader As String, strRow As String
On Error GoTo cleanup
Set OutApp = CreateObject("Outlook.Application")
Set Ash = Sheet1
Rcount = Application.WorksheetFunction.CountA(Ash.Columns(1))
For i = 1 To 16
strHeader = strHeader & " " & "<th>" & Ash.Cells(1, i) & "</th>"
Next
If Rcount >= 2 Then
For Rnum = 2 To Rcount
strRow = ""
For ir = 1 To 16
strRow = strRow & " " & "<td>" & Format(Ash.Cells(Rnum, ir), "#,##0") & "</td>"
Sheets("Form").Cells(8, ir) = Format(Ash.Cells(Rnum, ir), "#,##0")
Next
mailAddress = ""
On Error Resume Next
mailAddress = Application.WorksheetFunction. _
VLookup(Ash.Cells(Rnum, 1).Value, _
Worksheets("Mailinfo").Range("A1:C" & _
Worksheets("Mailinfo").Rows.Count), 3, False)
Sheets("Form").Copy
Set WB = ActiveWorkbook
FileName = Ash.Cells(Rnum, 1) & ".xls"
Kill "d:\" & FileName
On Error GoTo 0
WB.SaveAs FileName:="d:\" & FileName
If mailAddress <> "" Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = mailAddress
.Subject = " Chi ti" & ChrW(7871) & "t thu" & ChrW(7871) & " TNCN T5.2013: " & Ash.Range("B" & Rnum)
.Attachments.Add WB.FullName
.HTMLBody = "Dear Anh/Ch" & ChrW(7883) & ",</B><BR>" & _
"Xin vui lòng xem chi ti" & ChrW(7871) & "t thu" & ChrW(7871) & " TNCN T5.2013 nh" & ChrW(432) & " bên d" & ChrW(432) & ChrW(7899) & "i:<BR><BR>" & _
"<table border=1><tr>" & _
strHeader & _
"</tr><tr>" & _
strRow & _
"</tr>" & _
"</table>" & _
"<BR>" & _
"N" & ChrW(7871) & "u có gì th" & ChrW(7855) & "c m" & ChrW(7855) & "c xin vui lòng ph" & ChrW(7843) & "n h" & ChrW(7891) & "i s" & ChrW(7899) & "m<BR>" & _
"<B>Best regards,</B>" & _
"<BR>" & _
"<B>ABC<B>" & _
"<BR>" & _
Ash.Range("O5")
.Display 'Or use Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
WB.ChangeFileAccess Mode:=xlReadOnly
Kill WB.FullName
WB.Close SaveChanges:=False
Next Rnum
End If
MsgBox "Da tao xong email gui", vbInformation
'ThisWorkbook.Close (False)
cleanup:
Set OutApp = Nothing: Set OutMail = Nothing
End Sub
