以五秒为间隔发送电子邮件

Question

我正在尝试以五秒为间隔发送电子邮件。

我正在使用 Kernel32 Sleep 函数在我的代码中插入延迟。问题是我的电子邮件发送循环处理了所有的睡眠定时器，然后一起发送了一批电子邮件。

我用消息框来确认这一点。我认为这可能是因为多线程，但我不知道如何使它成为一个原子函数。

这是我的代码片段：

Public Declare PtrSafe Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As LongPtr)

Sub Send_Emails()

Dim i As Integer
For i = 1 To 4
    Sleep (5000)

    Dim OutlookApp As Outlook.Application
    Dim OutlookMail As Outlook.MailItem
    Set OutlookApp = New Outlook.Application
    Set OutlookMail = OutlookApp.CreateItem(olMailItem)

    With OutlookMail

        .BodyFormat = olFormatHTML
        .HTMLBody = "Hi there," & .HTMLBody
        .To = "abc@gmail.com"
        .Subject = "Hello World"
        .Send

    End With

Next i

End Sub

Answer 1

与 Application.Wait method (Excel) MSDN 一起使用，暂停宏直到指定时间或 Returns 如果指定时间已到则为真。

Option Explicit
Public Sub Example()
    Dim Exl As Excel.Application
    Set Exl = Excel.Application
    
    MsgBox ("Wait 5 Seconds!")
    Exl.Wait (Now + TimeValue("0:00:05"))
    MsgBox ("5 Seconds is up")
End Sub

Answer 2

您可以使用定时器来调用“发送电子邮件”功能有限次数。这意味着您也可以在消息之间工作，而等待或延迟功能可能会干扰标准操作。

Please note: sending and receiving is asynchronous so unless a long delay is utilised, e-mails may be received out of order or non-representative of the timing between them.

例如：

Option Explicit

Private Declare Function SetTimer Lib "User32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
    ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Private Declare Function KillTimer Lib "User32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

'TimerIDs to turn off timers. If a TimerID <> 0 then the timer is running
Private SendTimerID As Long
Private SendCount As Long

Sub SendEmails()
    Call SendStartTimer
End Sub

Private Sub SendStartTimer()
    SendCount = 0
    Call SendEventFunction
    Call ActivateTimer(5, AddressOf SendEvent, SendTimerID)
End Sub

Private Sub SendEvent(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
    On Error Resume Next
    Call SendEventFunction
    If SendCount = 4 Then DeactivateTimer SendTimerID
End Sub

Private Sub SendEventFunction()
    Dim OutlookApp As Outlook.Application: Set OutlookApp = New Outlook.Application
    Dim OutlookMail As Outlook.MailItem: Set OutlookMail = OutlookApp.CreateItem(olMailItem)
    With OutlookMail
        .BodyFormat = olFormatHTML
        .HTMLBody = "Hi There," & .HTMLBody
        .To = "someone@somewhere.com"
        .Subject = "Hello World: " & Int(Timer) 'Indicates seconds since midnight
        .Send
    End With
    Set OutlookMail = Nothing
    SendCount = SendCount + 1
End Sub

Private Function ActivateTimer(ByVal Seconds As Long, TimerFunc As Long, ByRef TimerID As Long) 'The SetTimer call accepts milliseconds
    On Error Resume Next
    If TimerID = 0 Then TimerID = SetTimer(0, 0, Seconds * 1000, TimerFunc) 'Check to see if timer is running before call to SetTimer
End Function

Private Function DeactivateTimer(ByRef TimerID As Long)
    On Error Resume Next
    If KillTimer(0, TimerID) <> 0 Then TimerID = 0
End Function

以五秒为间隔发送电子邮件

Send emails with a five second interval

outlook

vba

sleep