Option Explicit
#Const EarlyBinding = False
' Global variables
#If EarlyBinding Then
Dim FSO As Scripting.FileSystemObject
#Else
Dim FSO As Object
#End If
Sub SendMails()
' Local variables
Dim wsConfig As Worksheet
Dim rw As Integer
Dim Ans As VbMsgBoxResult
Dim sentCount As Long
Dim strBodyTemplate As String
' Get confirmation to proceed
Ans = MsgBox("Please make sure that following information is reported as of row 2" & vbNewLine & vbNewLine & _
"1-Column A: Email receipent " & vbNewLine & _
"2-Column B: Email cc " & vbNewLine & _
"3-Column C: Attach file" & vbNewLine & vbNewLine & _
"4-Column D: Recipient name" & vbNewLine & vbNewLine & _
"Click on OK if all good and click on Cancel to exit", vbOKCancel, "Confirm Before You Proceed!")
If Ans = vbCancel Then
MsgBox "You cancelled sending emails.", vbInformation, "Action Cancelled!"
Exit Sub
End If
' Initialization
Set FSO = CreateObject("Scripting.FileSystemObject")
Set wsConfig = ActiveSheet
' Try to find and load body template (HTML)
strBodyTemplate = BodyTemplate
If strBodyTemplate = "" Then
Exit Sub
End If
' Loop over sheet contents sending emails
sentCount = 0
For rw = 2 To wsConfig.Range("A1").CurrentRegion.Rows.Count
sentCount = sentCount + 1
SendMail wsConfig.Cells(rw, 1).Value, _
wsConfig.Cells(rw, 2).Value, _
"This is a test message", _
wsConfig.Cells(rw, 3).Value, _
BuildBody(wsConfig.Cells(rw, 4).Value, strBodyTemplate)
Next rw
' Cleanup
Set FSO = Nothing
MsgBox "Completed sending " & sentCount & " emails.", vbInformation, "Send Complete"
End Sub
Function BuildBody(strName As String, strBody As String) As String
' Stuff in any varuable values
BuildBody = Replace(strBody, "[[NAME]]", strName)
' BuildBody = Replace(BuildBody, "[[XXXXX]]", strName)
' BuildBody = Replace(BuildBody, "[[YYYYY]]", strName)
End Function
Function BodyTemplate() As String
' Local Variables
Const ForReading = 1
Const TristateUseDefault = -2
Dim strTemplatePath As String
' Locate HTML template file for emails (same name as workbook, with HTML extension)
strTemplatePath = Replace(Application.ActiveWorkbook.FullName, ".xlsm", ".html", 1, -1, vbTextCompare)
If FSO.FileExists(strTemplatePath) Then
' Read entire file into variable
With FSO.OpenTextFile(strTemplatePath, ForReading, False, TristateUseDefault)
BodyTemplate = .ReadAll
.Close
End With
Else
BodyTemplate = ""
MsgBox "Missing message template file """ & strTemplatePath & """.", vbCritical, "Template file error"
End If
End Function
' *************************************************************************
' Author:
' Creation date: 2020/04/16 08:39:26
' Description: Function to send e-mails
' ***************************************************************************
Sub SendMail(strTo As String, strCC As String, strSubject, strAttachment As String, strBody As String)
' Local variables
Dim strAttachmentPath As String
On Error GoTo ErrHandler
' Resolve any relative file references to a fully qualified path
strAttachmentPath = FSO.GetAbsolutePathName(strAttachment)
' Set Outlook Application object (early binding)
#If EarlyBinding Then
Dim objOutlook As Outlook.Application
#Else
Dim objOutlook As Object
#End If
Set objOutlook = CreateObject("Outlook.Application")
' Set Email object (early binding)
#If EarlyBinding Then
Dim objEmail As Outlook.MailItem
#Else
Dim objEmail As Object
Const olMailItem = 0
#End If
Set objEmail = objOutlook.CreateItem(olMailItem)
' Add information to email and send
With objEmail
.To = strTo
.CC = strCC
If FSO.FileExists(strAttachmentPath) Then
.Attachments.Add (strAttachmentPath)
End If
.Subject = strSubject
.HTMLBody = strBody
.Display ' ********** DISPLAY MESSAGE **********
'.Send
End With
' Clean-up and exit
Set objEmail = Nothing
Set objOutlook = Nothing
Exit Sub
ErrHandler:
' Display error information and exit sub
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: SendMail" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl), _
vbOKOnly + vbCritical, _
"An Error has Occured!"
End Sub
I take notes that the key tips for debugger are:
-Breakpoints through F9 and step over through F8
-Use Immediate windows (Ctrl +G) and directly type ? variable to check the value
-Add quick watch variable to the watch windows (Shift + F9)
-Display Quick watch windows
-Use debug.print if you want to see the values in immediate windows when your do the sequence step over/breakpoints
Additional question here: when you execute a procedure an you have an error related to a variable how to swiftly display the error message:
Best practices of codding:
-Option explicit/variable declaration
-Set up standard functions for most common actions: (Loop on worksheets, range etc.../Last Range, First range)
-Set up template/default procedures example: Confirmation/Critical/Info
-Comment procedures
Concerning standards functions/procedures template how to proceed here. Have a simple txt file or a default Module integrated to Excel when you open every time Excel?
Regards,
Luis.