[VBA] Create mail, attach files in Lotus Notes

[DonAndress]

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?

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

 

[DonAndress]

Just wanted to ask again.

 

[VBA Geek]

I cant test your code right now but try to use this:

Private Sub PREPARE_EMAIL(strServer As String, strMailBox As String, _
                          strSubject As String, strBody As String, _
                          strAttachment As String, sendTo As Variant, _
                          copyTo As Variant, BCCTo As Variant)


' if strServer and strMailBox are empty string, mail will be created in the personal mailbox
' sentTo, copyTo and BCCTo are 1 dimensional arrays containing email addresses


Dim noSession As Object, noDatabase As Object, noDocument As Object

Set noSession = VBA.CreateObject("Notes.NotesSession") ' create lotus instance
Set noDatabase = noSession.GetDatabase(strServer, strMailBox) ' connect to database
                         
If strMailBox = vbNullString Then noDatabase.OPENMAIL ' if connect to personal email then we need to run OPENMAIL

Set noDocument = noDatabase.CreateDocument ' create new document

' add recipients
If Not IsEmpty(sendTo) Then noDocument.ReplaceItemValue "SendTo", sendTo
If Not IsEmpty(copyTo) Then noDocument.ReplaceItemValue "CopyTo", copyTo
If Not IsEmpty(BCCTo) Then noDocument.ReplaceItemValue "Blindcopyto", BCCTo

' add subject
noDocument.ReplaceItemValue "Subject", strSubject

With noDocument.CreateRichTextItem("Body")
    .AppendText strBody
    If Not Len(strAttachment) = 0 Then .EmbedObject &H5AE, vbNullString, strAttachment
End With

noDocument.Sign
noDocument.Save True, True

Set noSession = Nothing
Set noDatabase = Nothing
Set noDocument = Nothing

MsgBox "Email Draft Successfully Created!", vbInformation + vbOKOnly
End Sub

 

[DonAndress]

I cant test your code right now but try to use this: [...]

Ok, so I tested it and modified a bit so Lotus didn't save this new email in the Draft folder but showed it in foreground instead.
And it works but I'd like to tweak it some more if possible.

At the moment Lotus adds attachment kind of inside but at the bottom of my signature. Two questions:

1. How do I put attachment right below the email body? (simple change in order of the code results with no attachment added)
2. How do I add multiple attachments? (there's a list of file names in the spreadsheet so it can be a loop of some sort)

Sub PREPARE_EMAIL()

Dim strServer As String, strMailBox As String, _
                          strSubject As String, strBody As String, _
                          strAttachment As String, sendTo As Variant, _
                          copyTo As Variant, BCCTo As Variant


Dim noSession As Object, noDatabase As Object, noDocument As Object


Set noSession = VBA.CreateObject("Notes.NotesSession") ' create lotus instance
Set noDatabase = noSession.GetDatabase(strServer, strMailBox) ' connect to database
                         
If strMailBox = vbNullString Then noDatabase.OPENMAIL ' if connect to personal email then we need to run OPENMAIL


Set noDocument = noDatabase.CreateDocument ' create new document


sendTo = "test1@test.com"
copyTo = "test2@test.com"
strSubject = "test topic"
strBody = "test body"
strAttachment = "C:\temp\Report.xlsm"


' add recipients
If Not IsEmpty(sendTo) Then noDocument.REPLACEITEMVALUE "SendTo", sendTo
If Not IsEmpty(copyTo) Then noDocument.REPLACEITEMVALUE "CopyTo", copyTo


' add subject
noDocument.REPLACEITEMVALUE "Subject", strSubject


With noDocument.CreateRichTextItem("Body")
    .APPENDTEXT ""
    If Not Len(strAttachment) = 0 Then .EmbedObject &H5AE, vbNullString, strAttachment
End With


noDocument.Sign


Set workspace = CreateObject("Notes.NotesUIWorkspace")
Call workspace.EditDocument(True, noDocument).GotoField("Body")
AppActivate "Lotus Notes"


Set noDocument = workspace.CurrentDocument
Call noDocument.InsertText(strBody)


Set noSession = Nothing
Set noDatabase = Nothing
Set noDocument = Nothing


End Sub

 

[VBA Geek]

this should propably help you

With noDocument.CreateRichTextItem("Body")
    .APPENDTEXT "This is the body of your email"
    If Not Len(strAttachment) = 0 Then .EmbedObject &H5AE, vbNullString, strAttachment
    If Not Len(strAttachment2) = 0 Then .EmbedObject &H5AE, vbNullString, strAttachment2
    If Not Len(strAttachment3) = 0 Then .EmbedObject &H5AE, vbNullString, strAttachment3
End With

 

[DonAndress]

this should propably help you

Well not really.
Your proposal puts the whole email body below my default Lotus signature.
This is why I first used .APPENDTEXT "" and moved the body inserting part to the end of the code.
Plus it's not like I can hard code the number of attachments added. It depends on the user so a loop would be better.

 

[VBA Geek]

Well not really.
Your proposal puts the whole email body below my default Lotus signature.
This is why I first used .APPENDTEXT "" and moved the body inserting part to the end of the code.
Plus it's not like I can hard code the number of attachments added. It depends on the user so a loop would be better.

what about this?

Sub makeEmail()
Dim objWorkSp  As Object
Dim objDoc     As Object

Dim i As Long

Set objWorkSp = CreateObject("notes.NOTESUIWORKSPACE")
Set objDoc = objWorkSp.COMPOSEDOCUMENT("", "", "Message")

objDoc.GOTOFIELD "Body"
objDoc.INSERTTEXT "My Body Email"

objDoc.FIELDSETTEXT "Subject", "My Subject"
objDoc.FIELDSETTEXT "SendTo", "Me@live.com"
objDoc.FIELDSETTEXT "CopyTo", "You@live.com"
objDoc.FIELDSETTEXT "Blindcopyto", "Us@live.com"


With objDoc.Document.CreateRichTextItem("Body") ' 3 attachments listed in cells A1, A2 and A3
    For i = 1 To 3
        .EmbedObject 1454, vbNullString, Range("A" & i).Value
    Next i
End With


Call objDoc.Save

MsgBox "Email Saved in Drafts! Please check your drafts folder!", vbInformation
Set objWorkSp = Nothing
Set objDoc = Nothing
End Sub

 

[DonAndress]

what about this?

Yes. This one works really well.

But one more question - how do I, instead of saving this email in the Draft folder, make it visible for further edit?

 

[VBA Geek]

Yes. This one works really well.

But one more question - how do I, instead of saving this email in the Draft folder, make it visible for further edit?

This should do what you are asking:

Sub makeEmail()
Dim objWorkSp               As Object
Dim UIDoc                   As Object
Dim backEndDB               As Object
Dim UIDB                    As Object
Dim backEndDoc              As Object
Dim i                       As Long
Dim universID               As String

Set objWorkSp = CreateObject("notes.NOTESUIWORKSPACE")
Set UIDoc = objWorkSp.COMPOSEDOCUMENT("", "", "Message")
Set UIDB = objWorkSp.CurrentDatabase
Set backEndDB = UIDB.DATABASE

' -----------------------------------------------------
UIDoc.GOTOFIELD "Body"
UIDoc.INSERTTEXT "My Body Email" & vbNewLine & vbNewLine

UIDoc.GOTOFIELD "EnterSendTo"
UIDoc.INSERTTEXT "Me@live.com"

UIDoc.GOTOFIELD "EnterCopyTo"
UIDoc.INSERTTEXT "You@live.com"

UIDoc.GOTOFIELD "EnterBlindCopyTo"
UIDoc.INSERTTEXT "Us@live.com"

UIDoc.GOTOFIELD "Subject"
UIDoc.INSERTTEXT "My Subject"
' -----------------------------------------------------

Set backEndDoc = UIDoc.Document

With backEndDoc.CreateRichTextItem("Body") ' example with 3 attachments listed in cells A1, A2 and A3
    For i = 1 To 3
        .EmbedObject 1454, vbNullString, Range("A" & i).Value
    Next i
End With

universID = backEndDoc.UniversalID ' store universal id

backEndDoc.mailOptions = "0" ' avoid getting save prompt before closing

' save & close ' modifications to rich txt items cant appear if doc is not closed & reopened
UIDoc.Save
UIDoc.Close True

Set backEndDoc = backEndDB.GetDocumentByUNID(universID)
objWorkSp.EDITDOCUMENT True, backEndDoc, False, , False

' ------------------------------------------------------
Set objWorkSp = Nothing
Set UIDoc = Nothing
Set backEndDoc = Nothing
Set backEndDB = Nothing
Set UIDB = Nothing
End Sub

 

[DonAndress]

This should do what you are asking

Yes, Sir!
This is exactly what I needed.
Many many many thanks!