群發郵件一般都是一下子全發出去了，這樣很有可能被判定為垃圾郵件，如果有一定的時間間隔會好很多
看了這位大神（余璜maray)的博貼(https://blog.csdn.net/maray/article/details/8133923)受啟發改了點,加了點代碼，如下：
Public Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Public Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function WinProcA(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long
KillTimer 0, idEvent
DoEvents
Sleep 100
'使用Alt+S發送郵件，這是本文的關鍵之處，免安全提示自動發送郵件全靠它了
Application.SendKeys "%s"
End Function
' 發送單個郵件的子程式
Sub SendMail(ByVal to_who As String, ByVal subject As String, ByVal body As String, ByVal attachement As String)
Dim objOL As Object
Dim itmNewMail As Object
Dim attaches
Dim attach
'參考Microsoft Outlook 物件
Set objOL = CreateObject("Outlook.Application")
Set itmNewMail = objOL.CreateItem(olMailItem)
With itmNewMail
.subject = subject '主旨
.HTMLbody = body '正文本文
.To = to_who '收件者
.Display '啟動Outlook發送視窗
KillTimer 0, idEvent
DoEvents
Sleep Int((10000 * Rnd) + 6000)
attaches = Split(attachement, ";")
For Each attach In attaches
If (Len(attach) > 0) Then
.Attachments.Add attach
End If
Next
SetTimer 0, 0, 0, AddressOf WinProcA
End With
Set objOL = Nothing
Set itmNewMail = Nothing
End Sub
'批量發送郵件
Sub BatchSendMail()
Dim rowCount, endRowNo
Dim newBody
Dim replaceCount, maxReplaceCount
Dim pattern
endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
'逐行發送郵件
For rowCount = 1 To endRowNo
' 替換當前行模板內容
maxReplaceCount = 2 ' 有幾處替換就寫幾，例子中有兩處，就寫2
newBody = Cells(rowCount, 3)
For replaceCount = 1 To maxReplaceCount
pattern = "[==" & CStr(replaceCount) & "==]"
newBody = WorksheetFunction.Substitute(newBody, pattern, Cells(rowCount, 4 + replaceCount))
Next
' 替換好了，發郵件咯！
SendMail Cells(rowCount, 1), Cells(rowCount, 2), newBody, Cells(rowCount, 4)
Next
End Sub
在“發送單個郵件的子程式”里加了 Sleep Int((10000 * Rnd) + 6000) ，為什么這么加，別問我，我是小白，我是費了九牛二虎之力，報著試試的態度。。。。。但是加在這么位置以后，確實管用，可以隨機抽取6-10秒時間(實際應該6-10分鐘，但這不利于測驗也沒試），發送郵件。。。
問題來了，發是可以發，美中不足的地方是第一組資料不自動發送，不知道為什么，不要笑話我，也許這個問題很簡單，但作為小白的我來說真看不出來為什，謝謝！再次感謝余璜maray！
uj5u.com熱心網友回復：
Sleep Int((10000 * Rnd) + 6000) 隨機秒數 rnd取值范圍多少的？轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/96991.html