我有一张excel表，其中包含3列A =电子邮件，B =姓名，C =是或否。 我当前的代码将通过电子邮件发送给电子表格中的所有用户，除了我需要发送20-25封电子邮件而不是暂停一分钟，然后发送下一个20-25而不是暂停一分钟等等。
Sub Test1()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim counter As Integer
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.BodyFormat = olFormatHTML
.Bcc = cell.Value
.Subject = "Submittal Exchange Subcontractor Training Invitation"
.Attachments.Add "C:\subinvite\planswift.png"
.HTMLBody = "<font size=""2"" face=""Calibri"">" & _
"Hello " & Cells(cell.Row, "B").Value _
& "," & _
"<B><br><br>You are invited to participate in an upcoming Submittal Exchange training session.</B><BR><BR>Please note that our subcontractor trainings are ongoing, in that they are held twice a week, every week, and the information in this email invitation never changes, so please feel free to join us on any Tuesday or Thursday that is convenient for you!<BR><BR>" & _
"<B>EVERY Tuesday at 1:30PM Central Standard Time</B> (2:30 PM Eastern, 12:30 PM Mountain, 11:30 PM Arizona, 11:30 AM Pacific, 10:30 AM AKST)<BR><B>Tuesday's Meeting ID:</B> 168303738<BR><B>Tuesday's Conference Call Number:</B> 1-636-277-0132<BR>" & _
"OR<BR><B>EVERY Thursday at 10:00 AM Central Standard Time</B> (11 AM Eastern, 9 AM Mountain, 8 AM Arizona, 8 AM Pacific, 7 AM AKST)<BR><B>Thursday's Meeting ID:</B> 966677330<BR><B>Thursday's Conference Call Number:</B> 1-213-493-0602<BR><BR><U>How to participate:</U><BR>" & _
"  - You can join the web meeting from your computer in your office, no travel needed.<br>  - You also will need a telephone to dial in to the conference call.<br>  - The training will last no more than 30 minutes.<br><br>" & _
"<u>Instructions to join the web meeting:</u><br> 1. Go to the Submittal Exchange public website (www.submittalexchange.com) and click on the<br>   ″Join A Go-To-Meeting″ link in the lower right hand corner under ″Quick Links″<br><br>" & _
" OR<br> If you are already logged in to Submittal Exchange, open the website, click on ″Help″ in the upper right corner, then click on the blue ″Meet Now″ button which is underneath ″Join a Training″<br> 2. Enter the nine digit meeting number:<br>" & _
" 3. Click ″OK″, ″Yes″, or ″Run″ if the web meeting software prompts you for permission<br> 4. Dial in to the conference call number when prompted to do so<br><br>" & _
"You are receiving this invitation because you have been added to the Submittal Exchange system as a subcontractor or contractor working for a GC or CM. If this information is not correct, please let us know. You should have received a separate email with your username and password information in order to log in to Submittal Exchange.<br><br>" & _
"If you have already attended a training session, please let us know and we will remove you from our reminder list.<br><br>Or, if you are unable to attend a live training session, the subcontractor training is available as a video demonstration on our Help Page. To access the Help Page, log into Submittal Exchange and click the<br>" & _
"Help link in the upper right hand corner of your screen. The subcontractor training video is located in the Trainings tab. The video is also a great resource if you were able to attend the live training and simply need a refresher later on. Our Help Page provides<br>immediate assistance for you 24/7. Look for and click on either the Help link or the green question mark to get tips on how to use the system, watch<br>demonstration videos, and more.<br>Thank you!<br><br>" & _
"<b>EXPLORE ANOTHER GREAT TEXTURA SOLUTION SPECIFICALLY FOR SUBCONTRACTORS!</b><br><br>" & _
"<html><body><div style=""width:200px;""><a href=""http://www.planswift.com/?AID=2572""><img src=""cid:planswift.png""><\img><\a><br></div><div style=""width:200px; text-align:left; float:right;""><b>Save time and money with the #1 Takeoff and Estimating software.<br><br>Download a Free 14 Day Trial of PlanSwift.<br><br>PlanSwift is the fastest and easiest to use software for accurately completing construction takeoffs on your computer screen. With PlanSwift's visual point-and-click interface, users can drag and drop individual products or assembled product groups directly onto a digitized blueprint. PlanSwift calculates the takeoffs automatically - saving valuable time and effort.</b><br></div></body><html>" & _
""
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
'increment counter and wait 60 seconds if it is 25 or higher
counter = counter + 1
If counter >= 25 Then
Application.Wait Now() + TimeValue("00:00:60")
counter = 0
End If
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
更新了@Aiken建议。
答案 0 :(得分：0)
您可以使用Application.Wait（documentation）并在For Each循环中添加计数器来实现此目的。
简化示例：
Dim counter As Integer
'...
For Each cell in Columns("A").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
'###########
'Email Code
'###########
'increment counter and wait 60 seconds if it is 25 or higher
counter = counter + 1
If counter >= 25 Then
Application.Wait Now() + TimeValue("0:01:00")
counter = 0
End If
End If
Next cell