Outlook ta taslak klasöründe bulunan mailleri göndermek için aşağıdaki Makro kodunu kullanıyorum.
Yapmak istediğim Taslak klasöründeki mailleri gönderirken belirli bir süre aralık vermesi.
Yani mailler arasında 5-10 saniye bekleme yaparak gönderim yapmak istiyorum.
Taslak kutumda bazen 1000 in üzerinde mail bulunabiliyor.
Aşağıdaki kodda değişiklik yaparak bu işlemi halledebilir miyim?
Yardımlarınız için şimdiden teşekürler.
- Kod: Tümünü seç
Sub SendAllDraftEmails()
Dim objDrafts As Outlook.Items
Dim objDraft As Object
Dim strPrompt As String
Dim nResponse As Integer
Dim i As Long
Dim merror As Integer, Gcount As Integer
On Error GoTo err_handle
Set objDrafts = Outlook.Application.Session.GetDefaultFolder(olFolderDrafts).Items
Gcount = objDrafts.Count
If objDrafts.Count > o Then
strPrompt = "Are you sure you want to send out all the drafts?"
nResponse = MsgBox(strPrompt, vbQuestion + vbYesNo, "Confirm Sending")
If nResponse = vbYes Then
For i = objDrafts.Count To 1 Step -1
objDrafts.Item(i).Send
Next
End If
If merror > 0 And merror = Gcount Then
MsgBox "No Draft Emails Sent!", vbCritical, "Email Sending Errors!"
ElseIf merror > 0 And merror < Gcount Then
MsgBox "Some Draft Emails were sent - " & Trim(Str(merror)) & " emails were not sent", vbCritical, "Email Sending Errors!"
Else
MsgBox "All Draft Emails Sent!", vbInformation, "Email Sending"
End If
Else
MsgBox "No Draft Emails Found!", vbExclamation, "No Draft Emails Found"
End If
Exit Sub
err_handle:
If Err = "-2147467259" Then
MsgBox "There must be at least one email address or contact group in the TO, CC or BCC fields" & vbCrLf & "Fix it and re-run your emails", vbExclamation, "Error in Email Address!"
merror = 1 + merror
Resume Next
End If
End Sub