DonAndress
Active Member
- Joined
- Sep 25, 2011
- Messages
- 364
- Office Version
- 2019
- 2016
- Platform
- Windows
Hello.
So I have the below code and it works well up until the part where I want to add attachments.
It doesn't return any error (nor does it jump to the ExitF part), it just goes through and no attachments show in the email body.
Could you please give me a hint what I do wrong?
So I have the below code and it works well up until the part where I want to add attachments.
It doesn't return any error (nor does it jump to the ExitF part), it just goes through and no attachments show in the email body.
Could you please give me a hint what I do wrong?
Code:
Sub sendmail()
Dim objNotes As Object, objNotesDB As Object, objNotesMailDoc, EmbedObj1 As Object
Dim SendItem, NCopyItem, BlindCopyToItem, i As Integer, rtitem
Dim Msg As String
On Error Resume Next
MacroWkb = ThisWorkbook.Name
If Not Err.Number = 0 Then
Err.Clear
GoTo ExitF
Else
On Error GoTo ExitF
Set objNotes = CreateObject("Notes.Notessession")
Set objNotesDB = objNotes.GetDatabase("", "")
Call objNotesDB.OPENMAIL
Set objNotesMailDoc = objNotesDB.CreateDocument
objNotesMailDoc.Form = "Memo"
Set SendItem = objNotesMailDoc.AppendItemValue("SendTo", "")
Set NCopyItem = objNotesMailDoc.AppendItemValue("CopyTo", "")
' Set BlindCopyToItem = objNotesMailDoc.AppendItemValue("BlindCopyTo", "")
objNotesMailDoc.SendTo = Workbooks(MacroWkb).Sheets("Data").Range("G7").Value
objNotesMailDoc.CopyTo = Workbooks(MacroWkb).Sheets("Data").Range("G8").Value
objNotesMailDoc.Subject = Workbooks(MacroWkb).Sheets("Data").Range("G10").Value
Set rtitem = objNotesMailDoc.CreateRichTextItem("Body")
Body = Workbooks(MacroWkb).Sheets("Data").Range("G12").Value & vbNewLine & vbNewLine & _
Workbooks(MacroWkb).Sheets("Data").Range("G13").Value & vbNewLine & _
Workbooks(MacroWkb).Sheets("Data").Range("G14").Value & vbNewLine & _
Workbooks(MacroWkb).Sheets("Data").Range("G15").Value & vbNewLine & _
Workbooks(MacroWkb).Sheets("Data").Range("G16").Value & vbNewLine & _
Workbooks(MacroWkb).Sheets("Data").Range("G17").Value & vbNewLine
rtitem.AddNewLine (1)
Call objNotes.Close
'this part creates and shows new email
Set workspace = CreateObject("Notes.NotesUIWorkspace")
Call workspace.EditDocument(True, objNotesMailDoc).GotoField("Body")
'this part adds body to the email
Set uidocument = workspace.CurrentDocument
Call uidocument.InsertText(Body)
rtitem.AddNewLine (1)
attachment1 = "C:\temp\Report.xlsm" ' Required File Name
[COLOR=#ff0000] Set AttachME = objNotesMailDoc.CreateRichTextItem("attachment1")[/COLOR]
[COLOR=#ff0000] Set EmbedObj1 = AttachME.EmbedObject(1454, "attachment1", "[/COLOR][COLOR=#ff0000]C:\temp\Report.xlsm[/COLOR][COLOR=#ff0000]", "") 'Required File Name[/COLOR]
Set objNotes = Nothing
AppActivate "Lotus Notes"
Exit Function
End If
ExitF:
Msg = "A draft E-Mail was not created! Please check your network connection and ensure you are logged into Lotus Notes."
MsgBox Msg, vbInformation, "Notesmail Draft..."
End Sub