I am using Excel and setup the following code to allow me to email my sheet through Lotus Notes. It works great for a single address but not for more than that. I searched the site and found several suggestions but could not implement one that provided the solution.
background:
email addresses are imported at load time from an SQL query. They are inserted into Sheet1 A1 in this format - EMAIL1, EMAIL2.
Email1 is John Doe
Email2 is Jane Doe
These are internal addresses to Notes.
If I use 2 internet addresses, like john.doe@email.com, jane.doe@email.com the sheet works and sends the both of them an email.
background:
email addresses are imported at load time from an SQL query. They are inserted into Sheet1 A1 in this format - EMAIL1, EMAIL2.
Email1 is John Doe
Email2 is Jane Doe
These are internal addresses to Notes.
If I use 2 internet addresses, like john.doe@email.com, jane.doe@email.com the sheet works and sends the both of them an email.
Code:
Sub Lotus_Notes_EMail()
' Declare Variables for file and macro setup
Dim UserName As String
Dim MailDbName As String
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim Attachment As String
ActiveWorkbook.Save
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
'Sheets("Sheet1").Visible = True
' Application.Goto Reference:="Sheet1"
ActiveSheet.Copy
' Name attachment
Attachment = "C:\Notes Attachment.htm"
With ActiveWorkbook
.SaveAs Attachment, FileFormat:=xlHtml
End With
yesno = MsgBox(" This will generate an e-mail confirmation." _
& vbCrLf & " Do you wish to send the Confirmation?" _
, vbYesNo + vbInformation, "Confirmation Generation")
Select Case yesno
Case vbNo
Exit Sub
End Select
Select Case yesno
Case vbYes
' Open and locate current LOTUS NOTES User
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, _
(Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If
' Create New Mail and Address Title Handlers
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
Recipient = Sheets("Sheet1").Range("A1").Value
MailDoc.SendTo = Recipient
' MailDoc.CopyTo = Array("A1")
MailDoc.Subject = "Server Patching Notice"
MailDoc.Body = _
Replace("Please see the email attachment regarding server patching of:@@" _
& Join(Application.Transpose(Range([B17], [B36].End(3))), "@") _
& "@@Thank you!", "@", vbCrLf)
' Select Workbook to Attach to E-Mail
MailDoc.savemessageonsend = True
attachment1 = Attachment
If attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", _
Attachment, "")
On Error Resume Next
End If
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.Send 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
' Routine to Generate a copy if required
' OnOff = MsgBox("Do you want to save a copy?", _
' vbYesNo + vbInformation, "Save Copy?")
' Select Case OnOff
' Case vbNo
' ActiveWorkbook.Close
' Exit Sub
' End Select
' Select Case OnOff
' Case vbYes
' Set NewBook = ActiveWorkbook
' Do
' fName = Application.GetSaveAsFilename
' Loop Until fName <> False
' NewBook.SaveAs Filename:=fName
' ActiveWorkbook.Close
' End Select
ActiveWorkbook.Close
' Kill the temp file here if necessary
Kill Attachment
Exit Sub
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Select
ActiveWorkbook.Close
End Sub
