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 = Sheet2
Rcount = Application.WorksheetFunction.CountA(Ash.[B8:B1000]) - 1
For i = 4 To 15
strHeader = strHeader & " " & "<th>" & Ash.Cells(7, i) & "</th>"
Next
If Rcount >= 2 Then
For Rnum = 8 To Rcount + 7
strRow = ""
With Sheets("PLUONG")
.Cells(5, 4) = Ash.Cells(Rnum, 2)
.Cells(6, 4) = Ash.Cells(Rnum, 3)
.Cells(7, 9) = Ash.Cells(Rnum, 16)
End With
For ir = 4 To 15
strRow = strRow & " " & "<td>" & Format(Ash.Cells(Rnum, ir), "#,##0") & "</td>"
Sheets("PLUONG").Cells(10, ir - 3) = Format(Ash.Cells(Rnum, ir), "#,##0")
Next
mailAddress = ""
On Error Resume Next
mailAddress = Ash.Cells(Rnum, 16)
Sheets("PLUONG").Copy
Set WB = ActiveWorkbook
FileName = Ash.Cells(Rnum, 2)
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 tiet bang luong: " & Ash.Range("C" & Rnum) _
& " (Voi ma so la " & Ash.Range("B" & Rnum) & ")"
.Attachments.Add WB.FullName
.HTMLBody = "<B>Dear " & Ash.Range("C" & Rnum) & ",</B><BR>" & _
"Xin vui long xem chi tiet bang luong nhu ben duoi hoac file dinh kem:<BR><BR>" & _
"<table border=1><tr>" & _
strHeader & _
"</tr><tr>" & _
strRow & _
"</tr>" & _
"</table>" & _
"<BR>" & _
"Neu thay co gi thac mac xin vui long phan hoi som.<BR>" & _
"<B>Xin Cam on,</B>" & _
"<BR>" & _
"<B>HLMT<B>"
.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
cleanup:
Set OutApp = Nothing: Set OutMail = Nothing
End Sub
