Private Sub Send_File_Click()
Dim OutlookApp As Object, MailItem As Object, i As Integer
Dim FileName As String, WB As Workbook
Application.DisplayAlerts = False
With Sheet1
For i = 1 To Application.WorksheetFunction.CountA(.[A6:A1000])
.[A5:A1000].AutoFilter Field:=1, Criteria1:=.Cells(i + 5, 1)
.[A4].CurrentRegion.Copy Sheet2.Range("A3")
.[A4].CurrentRegion.CopyPicture
Sheets("Luong").Copy
Set WB = ActiveWorkbook
FileName = "BangLuong" '.Cells(i + 5, 1)
On Error Resume Next
Kill "D:\" & FileName
WB.SaveAs FileName:="D:\" & FileName
Set OutlookApp = CreateObject("Outlook.Application")
Set MailItem = OutlookApp.CreateItem(0)
With MailItem
.To = Sheet1.Cells(i + 5, 2)
.Subject = "Bang luong cua: " & Sheet1.Cells(i + 5, 1)
.Attachments.Add WB.FullName
.HTMLBody = " <B>Dear " & Sheet1.Cells(i + 5, 1) & "</B>" & _
"<BR><BR><BR><BR>Neu co thac mac gi xin phan hoi som" & _
"<BR><B>Xin cam on,</B><BR>" & _
"<BR><B>HLMT</B>"
.Display
End With
SendKeys "({DOWN})", True
SendKeys "({DOWN})", True
SendKeys "^({v})", True
WB.ChangeFileAccess Mode:=xlReadOnly
Kill WB.FullName
WB.Close SaveChanges:=False
Next
.ShowAllData
End With
Application.DisplayAlerts = True
Set OutlookApp = Nothing
Set MailItem = Nothing
End Sub
