Send IBM Notes email using VBA?

Question

I have a spreadsheet with a list of email recipients in column Q and a list of file attachments in column F:

Column f       Column Q
File1.xls      email1
File2.xls      email2

My code is supposed to loop through all the emails in column Q and send the recipient an email with the corresponding file attachment from column F.

This bit works fine, but i also want to copy a range from my excel workbook and paste this into the email body of each email.

The excel worksheet range will not paste correctly into the email body. It is producing the following result:

Good afternoon,

Please see attached an announcement of the spot buy promotion for week 21, 2017.

Please can you confirm within 24 hours.


 - HarviestounBrewery.xlsx



Kind regards / Mit freundlichen Grüßen,

The Food Specials Team




<html xmlns:o="urn:schemas-microsoft-com:office:office"
xmlns:x="urn:schemas-microsoft-com:office:excel"
xmlns="http://www.w3.org/TR/REC-html40">

<head>
<meta http-equiv=Content-Type content="text/html; charset=windows-1252">
<meta name=ProgId content=Excel.Sheet>
<meta name=Generator content="Microsoft Excel 15">
<link rel=File-List href="28-02-17%2017-37-22_files/filelist.xml">
<style id="Sheet66_4180_Styles">
<!--table
    {mso-displayed-decimal-separator:"\.";
    mso-displayed-thousand-separator:"\,";}
.xl154180
    {padding-top:1px;
    padding-right:1px;
    padding-left:1px;
    mso-ignore:padding;
    color:black;
    font-size:10.0pt;
    font-weight:400;
    font-style:normal;
    text-decoration:none;
    font-family:Arial, sans-serif;
    mso-font-charset:0;
    mso-number-format:General;
    text-align:general;
    vertical-align:bottom;
    mso-background-source:auto;
    mso-pattern:auto;
    white-space:nowrap;}
.xl634180
    {padding-top:1px;
    padding-right:1px;
    padding-left:1px;
    mso-ignore:padding;
    color:#595959;
    font-size:14.0pt;
    font-weight:400;
    font-style:normal;
    text-decoration:underline;
    text-underline-style:single;
    font-family:Calibri, sans-serif;
    mso-font-charset:0;
    mso-number-format:General;
    text-align:left;
    vertical-align:middle;
    background:#F2F2F2;
    mso-pattern:black none;
    white-space:nowrap;}
.xl644180
    {padding-top:1px;
    padding-right:1px;
    padding-left:1px;
    mso-ignore:padding;
    color:#595959;
    font-size:14.0pt;
    font-weight:400;
    font-style:normal;
    text-decoration:underline;
    text-underline-style:single;
    font-family:Calibri, sans-serif;
    mso-font-charset:0;
    mso-number-format:General;
    text-align:general;
    vertical-align:middle;
    background:#F2F2F2;
    mso-pattern:black none;
    white-space:nowrap;}
.xl654180
    {padding-top:1px;
    padding-right:1px;
    padding-left:1px;
    mso-ignore:padding;
    color:#595959;
    font-size:14.0pt;
    font-weight:400;
    font-style:normal;
    text-decoration:underline;
    text-underline-style:single;
    font-family:Calibri, sans-serif;
    mso-font-charset:0;
    mso-number-format:"Short Date";
    text-align:left;
    vertical-align:middle;
    background:#F2F2F2;
    mso-pattern:black none;
    white-space:nowrap;}
.xl664180
    {padding-top:1px;
    padding-right:1px;
    padding-left:1px;
    mso-ignore:padding;
    color:#595959;
    font-size:14.0pt;
    font-weight:400;
    font-style:normal;
    text-decoration:none;
    font-family:Calibri, sans-serif;
    mso-font-charset:0;
    mso-number-format:General;
    text-align:general;
    vertical-align:middle;
    background:#F2F2F2;
    mso-pattern:black none;
    white-space:nowrap;}
-->
</style>
</head>

<body>
<!--[if !excel]>&nbsp;&nbsp;<![endif]-->
<!--The following information was generated by Microsoft Excel's Publish as Web
Page wizard.-->
<!--If the same item is republished from Excel, all information between the DIV
tags will be replaced.-->
<!----------------------------->
<!--START OF OUTPUT FROM EXCEL PUBLISH AS WEB PAGE WIZARD -->
<!----------------------------->

<div id="Sheet66_4180" align=left x:publishsource="Excel">

<table border=0 cellpadding=0 cellspacing=0 width=1763 style='border-collapse:
 collapse;table-layout:fixed;width:1327pt'>
 <col width=65 span=14 style='mso-width-source:userset;mso-width-alt:2377;
 width:49pt'>
 <col width=123 style='mso-width-source:userset;mso-width-alt:4498;width:92pt'>
 <col width=65 style='width:49pt'>
 <col width=135 style='mso-width-source:userset;mso-width-alt:4937;width:101pt'>
 <col width=130 style='mso-width-source:userset;mso-width-alt:4754;width:98pt'>
 <col width=65 span=5 style='width:49pt'>
 <col width=75 style='mso-width-source:userset;mso-width-alt:2742;width:56pt'>
 <tr height=25 style='height:18.75pt'>
  <td height=25 class=xl634180 colspan=2 width=130 style='height:18.75pt;
  width:98pt'>Supplier</td>
  <td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
  mso-ignore:visibility'>&nbsp;</u></td>
  <td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
  mso-ignore:visibility'>&nbsp;</u></td>
  <td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
  mso-ignore:visibility'>&nbsp;</u></td>
  <td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
  mso-ignore:visibility'>&nbsp;</u></td>
  <td class=xl644180 colspan=2 width=130 style='width:98pt'>Contact Name</td>
  <td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
  mso-ignore:visibility'>&nbsp;</u></td>
  <td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
  mso-ignore:visibility'>&nbsp;</u></td>
  <td class=xl644180 colspan=2 width=130 style='width:98pt'>Contact Email</td>
  <td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
  mso-ignore:visibility'>&nbsp;</u></td>
  <td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
  mso-ignore:visibility'>&nbsp;</u></td>
  <td class=xl654180 width=123 style='width:92pt'>Delivery Date</td>
  <td class=xl634180 width=65 style='width:49pt'><u style='visibility:hidden;
  mso-ignore:visibility'>&nbsp;</u></td>
  <td class=xl644180 width=135 style='width:101pt'>Notice</td>
  <td class=xl644180 width=130 style='width:98pt'><u style='visibility:hidden;
  mso-ignore:visibility'>&nbsp;</u></td>
  <td class=xl644180 width=65 style='width:49pt'>Action</td>
  <td class=xl664180 width=65 style='width:49pt'>&nbsp;</td>
  <td class=xl644180 width=65 style='width:49pt'>Open</td>
  <td class=xl664180 width=65 style='width:49pt'>&nbsp;</td>
  <td class=xl664180 width=65 style='width:49pt'>&nbsp;</td>
  <td class=xl644180 width=75 style='width:56pt'>Remove</td>
 </tr>
 <![if supportMisalignedColumns]>
 <tr height=0 style='display:none'>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=123 style='width:92pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=135 style='width:101pt'></td>
  <td width=130 style='width:98pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=65 style='width:49pt'></td>
  <td width=75 style='width:56pt'></td>
 </tr>
 <![endif]>
</table>

</div>


<!----------------------------->
<!--END OF OUTPUT FROM EXCEL PUBLISH AS WEB PAGE WIZARD-->
<!----------------------------->
</body>

</html>

Heres my code:

Sub Send_Email2()

Dim answer As Integer
    answer = MsgBox("Are you sure you want to Send All Announcements?", vbYesNo + vbQuestion, "Notice")
    If answer = vbNo Then
    Exit Sub

    Else

Dim rnBody As Range
Dim Data As DataObject

Set rnBody = Worksheets(1).Range("N3")
rnBody.Copy

Dim Maildb As Object
Dim MailDoc As Object
Dim Body As Object
Dim Session As Object
Dim i As Long
Dim j As Long
Dim server, mailfile, user, usersig As String
Dim LastRow As Long, ws As Worksheet
LastRow = Worksheets(1).Range("F" & Rows.Count).End(xlUp).Row  'Finds the last used row

j = 18



'Start a session of Lotus Notes
Set Session = CreateObject("Notes.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
Set Maildb = Session.CurrentDatabase
Set stream = Session.CreateStream
' Turn off auto conversion to rtf
Session.ConvertMime = False


With ThisWorkbook.Worksheets(1)

For i = 18 To LastRow

'Create the Mail Document
Session.ConvertMime = False ' Do not convert MIME to rich text

Set MailDoc = Maildb.CreateDocument
Call MailDoc.ReplaceItemValue("Form", "Memo")
'Set From
Call MailDoc.ReplaceItemValue("Principal", "Food Specials <mailto:Food.Specials@Lidl.co.uk>")
Call MailDoc.ReplaceItemValue("ReplyTo", "Food.Specials@Lidl.co.uk")
Call MailDoc.ReplaceItemValue("DisplaySent", "Food.Specials@Lidl.co.uk")



'Set the Recipient of the mail
Call MailDoc.ReplaceItemValue("SendTo", Range("Q" & i).value)
'Call MailDoc.ReplaceItemValue("CopyTo", "food.specials@lidl.co.uk")

'Set subject of the mail
Call MailDoc.ReplaceItemValue("Subject", "Promotion Announcement for week " & Range("I8").value & ", " & Range("T8").value & " - Confirmation required")



'Create and set the Body content of the mail
Set Body = MailDoc.CREATERICHTEXTITEM("Body")
If Range("I10").value <> "" Then
Call Body.APPENDTEXT("Good " & Range("A1").value & "," & vbNewLine & vbNewLine _
    & "Please see attached an announcement of the spot buy promotion for week " & Range("I8").value & ", " & Range("T8").value & "." & vbNewLine & vbNewLine _
    & "Please can you confirm within 24 hours." & vbNewLine & vbNewLine _
    & Range("I10").value & vbNewLine)
Else
Call Body.APPENDTEXT("Good " & Range("A1").value & "," & vbNewLine & vbNewLine _
    & "Please see attached an announcement of the spot buy promotion for week " & Range("I8").value & ", " & Range("T8").value & "." & vbNewLine & vbNewLine _
    & "Please can you confirm within 24 hours." & vbNewLine)
End If

'Embed Excel Sheet Range
Set Data = New DataObject
Data.GetFromClipboard

Call Body.ADDNEWLINE(2)
Call Body.EmbedObject(1454, "", Range("F" & i).value, "Attachment")

'create an signature
Call Body.ADDNEWLINE(4)
Call Body.APPENDTEXT("Kind regards / Mit freundlichen Grüßen," & vbNewLine & vbNewLine _
    & "The Food Specials Team" & vbNewLine & vbNewLine)

Dim rng As Range
Set rng = ThisWorkbook.Worksheets(1).Range("G17:AD17").SpecialCells(xlCellTypeVisible)


'create an signature
Call Body.ADDNEWLINE(3)
Call Body.APPENDTEXT(rangetoHTML(rng))




'Example to save the message (optional) in Sent items
    MailDoc.SaveMessageOnSend = True
'Send the document
'Gets the mail to appear in the Sent items folder
    Call MailDoc.ReplaceItemValue("PostedDate", Now())
    Call MailDoc.Send(False)

    Set MailDoc = Nothing


    j = j + 1

               Next i
               End With




'Clean Up the Object variables - Recover memory
    Set Maildb = Nothing
     Set Body = Nothing
    Set Session = Nothing

    Application.CutCopyMode = False


MsgBox "Success!" & vbNewLine & "Announcements have been sent."

End If
End Sub





Function rangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    rangetoHTML = ts.ReadAll
    ts.Close
    rangetoHTML = Replace(rangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing

End Function

I suspect the range won't copy / paste correctly because my email appears to be written in plain text. But i do not know how to convert this to HTML.

Please can someone show me where i am going wrong and how i can get my range to copy/paste as required.

Thanks

Have you looked at [this](http://stackoverflow.com/a/686685/4717755) answer? — PeterT, Feb 28 '17 at 18:09

Send IBM Notes email using VBA?

0 Answers0