Home > OS >  Vba small white excel outlook mass email time interval measurement can be used but have a question
Vba small white excel outlook mass email time interval measurement can be used but have a question

Time:09-29

Mass email is usually sent all at once, it is very likely to be judged to be spam, if there is a certain time interval would be much better
To see the great god (Yu Huang maray) blog post (https://blog.csdn.net/maray/article/details/8133923) inspired changes a little, add a little bit of code, as follows:

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)




The 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
Use Alt + S email, this is the key of this article, from safety tips automatically send E-mail on which all the
Application. The SendKeys "% s"
End the Function


'send E-mail a single subroutine
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 the attach

Reference Microsoft Outlook objects'
The Set objOL=CreateObject (" Outlook. Application ")
The Set itmNewMail=objOL. The CreateItem (olMailItem)
With itmNewMail
Substance. Subject=subject '
The HTMLbody text this article
=body 'To recipient=to_who '
. The Display 'start Outlook send window
KillTimer 0, idEvent
DoEvents
Sleep Int (Rnd (10000 *) + 6000)
Attaches=Split (attachement, ";" )

For Each attach attaches In
If (Len (attach) & gt; 0) Then
. Attachments. Add the attach
End the If
Next
The SetTimer 0, 0, 0, AddressOf WinProcA
End With




The Set objOL=Nothing
The Set itmNewMail=Nothing
End Sub



'bulk email
Sub BatchSendMail ()
Dim the rowCount, endRowNo
Dim newBody
Dim replaceCount, maxReplaceCount
Dim the pattern
EndRowNo=Cells (1, 1) CurrentRegion. Rows. Count


'line by line to send mailFor the rowCount=1 To endRowNo
'line to replace the current template content
MaxReplaceCount=2 'would have written a few places to replace a few, have two case, write 2
NewBody=Cells (rowCount, 3)

For replaceCount=1 To maxReplaceCount
The pattern="[==" & amp; CStr (replaceCount) & amp; "==]"
NewBody=WorksheetFunction. Substitute (newBody, pattern, Cells (rowCount, 4 + replaceCount))
Next
'well, replace the mail!
The SendMail Cells (rowCount, 1), Cells (2) the rowCount, newBody, Cells (rowCount, 4)

Next
End Sub

In "sending a single subroutine" added Sleep Int (Rnd (10000 *) + 6000), why is it so, don't ask me, I am a little white, I am the skylight, reported a try attitude,,,,,,, but after such a position, do work, can be randomly selected 6-10 seconds (actual should be 6-10 minutes, but didn't try this for testing), send E-mail,,,

Question, hair can be hair, fly in the ointment was the first set of data is not sent automatically, do not know why, don't laugh at me, maybe this question is very simple, but as a small white I can't really see why, thank you! Thank you again for Yu Huang maray!

CodePudding user response:

Sleep Int (Rnd (10000 *) + 6000) random number of seconds of Rnd values range?
  • Related