MagicalHippo
Board Regular
- Joined
- Oct 13, 2015
- Messages
- 122
I created a program that loops through a list of 25-50 names. Basically what I want to do when the loop starts, if "RecpName" is spelled incorrectly, then throw that into another Sheet.
I simply want the loop to keep going even if there is a error in a way a named is spelled, Capture the error, and after the loop is completed, tell the user of all the incorrectly spelled names that the program couldn't send emails to.
I simply want the loop to keep going even if there is a error in a way a named is spelled, Capture the error, and after the loop is completed, tell the user of all the incorrectly spelled names that the program couldn't send emails to.
Code:
Sub Send_HTML_Email()
Const ENC_IDENTITY_8BIT = 1729
'Send Lotus Notes email containing links to files on local computer
Dim NSession As Object 'NotesSession
Dim NDatabase As Object 'NotesDatabase
Dim NStream As Object 'NotesStream
Dim NDoc As Object 'NotesDocument
Dim NMIMEBody As Object 'NotesMIMEEntity
Dim SendTo As String
Dim subject As String
Dim HTML As String, HTMLbody As String
Dim wb As Workbook
Dim ws As Worksheet
Dim lstrow As Long, j As Long
Dim RecpName As String, candiName As String
Dim a As Hyperlink
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Detail")
' 'Instantiate the Lotus Notes COM's Objects.
lstrow = ws.Range("B" & Rows.Count).End(xlUp).Row
Set NSession = CreateObject("Notes.NotesSession") 'using Lotus Notes Automation Classes (OLE)
Set NDatabase = NSession.GetDatabase("", "")
If Not NDatabase.IsOpen Then NDatabase.OPENMAIL
For j = 3 To lstrow
RecpName = ws.Cells(j, 2).Text
candiName = ws.Cells(j, 1).Text
SendTo = RecpName
subject = wb.Worksheets("Email Settings").Range("B1").Text
Debug.Print subject
Set NStream = NSession.CreateStream
HTMLbody = "<p>" & "Hi " & ws.Cells(j, 2).Text & "," & "</p>" & _
vbCrLf & _
"<p>" & Sheets("Email Settings").Cells(2, 2).Text & vbCrLf & _
Sheets("Detail").Cells(j, 1).Text & "</p>" & vbCrLf & _
"<p>" & Sheets("Email Settings").Cells(3, 2).Text & _
"<br>" & Sheets("Email Settings").Cells(4, 2).Text & _
"<br>" & Sheets("Email Settings").Cells(5, 2).Text & _
"<br>" & Sheets("Email Settings").Cells(6, 2).Text & "</p>" & _
"<p>" & Sheets("Email Settings").Cells(9, 2).Text & _
"<br>" & Sheets("Email Settings").Cells(10, 2).Text & _
"<br>" & Sheets("Email Settings").Cells(11, 2).Text & _
"<br>" & Sheets("Email Settings").Cells(12, 2).Text & _
"<br>" & Sheets("Email Settings").Cells(13, 2).Text & _
"<br>" & Sheets("Email Settings").Cells(14, 2).Text & _
"<br>" & Sheets("Email Settings").Cells(15, 2).Text & "</p>"
HTML = "<html>" & vbLf & _
"<head>" & vbLf & _
"****** http-equiv=""Content-Type"" content=""text/html; charset=UTF-8""/>" & vbLf & _
"</head>" & vbLf & _
"******>" & vbLf & _
HTMLbody & _
"</body>" & vbLf & _
"</html>"
NSession.ConvertMime = False 'Don't convert MIME to rich text
Set NDoc = NDatabase.CreateDocument()
With NDoc
.Form = "Memo"
.subject = subject
.SendTo = Split(SendTo, ",")
Set NMIMEBody = .CreateMIMEEntity
NStream.WriteText HTML
NMIMEBody.SetContentFromText NStream, "text/html; charset=UTF-8", ENC_IDENTITY_8BIT
.Send False
.Save True, False, False
End With
NSession.ConvertMime = True 'Restore conversion
Next j
Set NDoc = Nothing
Set NSession = Nothing
MsgBox "The e-mail has successfully been created and distributed", vbInformation
End Sub
