Như thế này đây bạn, khi gửi 1 mail đi thì phải ấn allow, phải làm sao để gửi mà ko phai allow? Mong các pro giúp
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"
.Send 'Or use Display
End With
Set OutMail = Nothing
End If
On Error GoTo 0
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
.
