Nhờ các anh chị giúp đỡ ạ
mail không dán phần copy vào body thư
và em muốn bỏ đính kèm file di ạ
Sub SendMail()
Dim OutlookApp As Object, MailItem As Object, i As Integer
Dim FileName As String, WB As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To Application.WorksheetFunction.CountA(Sheet1.[A14:A1000]) - 2
Sheet2.[G2] = i
If UCase(Sheet2.[J4]) = "YES" Then
With Sheets("pay slip")
.Copy
.[A1:E31].CopyPicture
End With
Set WB = ActiveWorkbook
FileName = "BangLuong"
On Error Resume Next
Kill "E:" & FileName
WB.SaveAs FileName:="E:" & FileName
Set OutlookApp = CreateObject("Outlook.Application")
Set MailItem = OutlookApp.CreateItem(0)
With MailItem
.To = Sheet2.[G4]
.Subject = "Bang luong cua: " & Sheet2.[C3]
.Attachments.Add WB.FullName
.HTMLBody = "<B>Xin chao: " & Sheet2.[C3] & "</B>" & _
"<BR><BR>Xin vui long kiem tra lai chi tiet bang luong nhu ben duoi: <BR>" & _
"<BR><BR><BR><BR>Neu co thac mac gi xin phan hoi som" & _
"<BR><B>Xin cam on,</B><BR>" & _
"<BR><B>Lê Thi Hà </B>"
.Display
End With
SendKeys "({DOWN})", True
SendKeys "({DOWN})", True
SendKeys "({DOWN})", True
SendKeys "({DOWN})", True
SendKeys "({DOWN})", True
SendKeys "^({v})", True
WB.ChangeFileAccess Mode:=xlReadOnly
Kill WB.FullName
WB.Close SaveChanges:=False
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set OutlookApp = Nothing
Set MailItem = Nothing
End Sub