Forum Discussion
VBA code making pdfs and emailing in outlook blows up Outlook
Code below Blows up Outlook after 12 emails go out. Any way to add a delay after each email to keep that from happening. Maximum # of emails would be 40.
Got this code from a user here last May. It works great until the number of emails exceeds 12 then I get 12 emails sent and email failure notifications from Outlook for the rest.
Sub CreatePersonSpecificPDFs()
' -------------------------------
' Declarations
' -------------------------------
' This sub creates a .pdf file for individual timesheets for the event and "Blindly"
' emails them to the email address found on each timesheet
' Workbook object used 1. to loop through worksheets,
' 2. specify which worksheet to export as PDF.
Dim wsSource As Worksheet
Dim sEmailAddress As String
' File name and location.
Dim sPath As String
Dim sFileName As String
Dim sFileSpec As String
' Array holding "tab names" of person-specific worksheets.
Dim asSheetTabNames() As String
' Count of qualifying worksheets.
Dim iSheetsFound As Long
' Used for looping person-specific worksheets found.
Dim iSheet As Long
' Objects used for sending email via outlook.
Dim oOutlookApp As Object
Dim oMailItem As Object
Dim sMsg As String
' -------------------------------
' Initializations
' -------------------------------
sPath = ThisWorkbook.Path & "\"
iSheetsFound = 0
' -------------------------------
' ID Sheets to Export
' -------------------------------
' Iterate through the worksheets collection looking for person-
' specific worksheets to be exported as a PDF file.
' Load person-specific worksheet TAB names into the array.
For Each wsSource In ThisWorkbook.Worksheets
' Use worksheets' "code names" to determine which worksheets are to be exported.
' A person-specific worksheet has codename like Template# or like Template##
' where # is a wildcard indicating any numeric value.
If wsSource.CodeName Like "Template#" Or wsSource.CodeName Like "Template##" _
Then
iSheetsFound = iSheetsFound + 1
ReDim Preserve asSheetTabNames(iSheetsFound)
asSheetTabNames(iSheetsFound) = wsSource.Name
End If
Next wsSource
' -------------------------------------------------
' Check no Person-specific Sheets Found
' -------------------------------------------------
If iSheetsFound = 0 _
Then
sMsg = "No individual timesheets have been created"
MsgBox sMsg, vbCritical, "Create then email PDFs"
Exit Sub
End If
' ---------------------------------
' Export then Email PDFs
' ---------------------------------
For iSheet = 1 To iSheetsFound
sFileName = asSheetTabNames(iSheet) & ".PDF"
sFileSpec = sPath & sFileName
' Delete the file if it already exists.
On Error Resume Next
Kill sFileSpec
On Error GoTo 0
Set wsSource = ThisWorkbook.Worksheets(asSheetTabNames(iSheet))
wsSource.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sFileSpec, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' Get email address from the person-specific worksheet.
sEmailAddress = wsSource.Range("EmailAddress").Value
' Set up Outlook objects for sending email.
Set oOutlookApp = CreateObject("Outlook.Application")
Set oMailItem = oOutlookApp.CreateItem(0)
' Attach the single person-specific PDF file to an email.
With oMailItem
.To = "**Email removed for security* @aol.com)"
' .To = sEmailAddress 'Specify the email address of the recipient
.Subject = "Time Sheet"
.Body = "Please find attached your timesheet. Respond to this email with your acceptance."
.Attachments.Add sFileSpec
.Send
End With
Set oOutlookApp = Nothing
Set oMailItem = Nothing
Next iSheet
End Sub
2 Replies
To add a delay after each email is sent using VBA to prevent Outlook from crashing, you can use the Application.Wait method. This method pauses the execution of the code for a specified amount of time. Here is how you can modify your code to include a delay:
vbaCopy code
Sub CreatePersonSpecificPDFs() ' ... (previous code) ' --------------------------------- ' Export then Email PDFs ' --------------------------------- Dim DelayBetweenEmails As Double DelayBetweenEmails = 2 ' Set the delay in seconds (adjust as needed) For iSheet = 1 To iSheetsFound ' ... (previous code) ' Attach the single person-specific PDF file to an email. With oMailItem .To = "**Email removed for security* @aol.com)" .Subject = "Time Sheet" .Body = "Please find attached your timesheet. Respond to this email with your acceptance." .Attachments.Add sFileSpec .Send End With ' Add a delay after each email Application.Wait Now + TimeValue("00:00:" & DelayBetweenEmails) ' ... (previous code) Next iSheet End SubIn this modification, a delay of 2 seconds (DelayBetweenEmails = 2) is added after each email is sent. You can adjust the value of DelayBetweenEmails as needed to find a suitable delay time that prevents Outlook from crashing.
Please note that adding delays in loops may slow down the overall execution of the code, but it can help prevent issues with Outlook when sending multiple emails in quick succession. Adjust the delay time based on your system's performance and requirements.
Thanks for the input. I have a delay working but there are still some issues. Im working with some folks in Mr Excel on those issues. Thanks again
