Sub SendMail()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim Addresslist As Scripting.Dictionary
Application.ScreenUpdating = False
Set Addresslist = New Scripting.Dictionary
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "J").Value) = "yes" Then
On Error Resume Next
Addresslist.Add cell.Value, cell.Value
If Err.Number = 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Value
.Subject = "Phieu luong: " & Cells(cell.Row, "A").Value
.Body = "Dear " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Xin vui long xem chi tiet bang luong nhu ben duoi:" & _
vbNewLine & vbNewLine & _
"+ He So Chuc Danh: " & Cells(cell.Row, "C").Value & _
vbNewLine & _
"+ So ngay cong: " & Cells(cell.Row, "D").Value & _
vbNewLine & _
"+ Luong CD: " & Cells(cell.Row, "E").Value & _
vbNewLine & _
"+ Phu cap DT: " & Cells(cell.Row, "F").Value & _
vbNewLine & _
"+ Phu cap doan the: " & Cells(cell.Row, "G").Value & _
vbNewLine & _
"+ Tru BHXH, BHYT: " & Cells(cell.Row, "H").Value & _
vbNewLine & _
"+ Luong CK: " & Cells(cell.Row, "I").Value & _
vbNewLine & vbNewLine & _
"Cam on"
.Display 'Or use Send
End With
Set OutMail = Nothing
End If
On Error GoTo 0
End If
Next cell
Set OutApp = Nothing
Set Addresslist = Nothing
Application.ScreenUpdating = True
End Sub
Ai giúp em giải thích code này với
Em gửi thử toàn báo lỗi 404 - you don't connected!
