How to add Prevent Copying to email from Excel to Lotus Notes

[abreu]

Hi everyone,

I have tried for weeks now to add the "Prevent Copying" to an email automatically generated from Excel, via VBA, to Lotus Notes. I have found code examples online, however, I couldn't get it to work on the code below. As I'm relatively new to VBA, this might be something easy, but I just haven't been able to figure it out.

The code below that I'm trying to use should mainly copy and paste an excel range as bitmap in the body of the email, add prevent copying and save it as draft.

Any help would be greatly appreciated!

Sub Email_Bitmap_Prevent_Copying()

Dim Send_Recipients As Variant
Dim Email_Subject As Variant
Dim Notes As Object
Dim WorkSpace As Object
Dim UIDoc As Object
Dim MailDbName As String

 Application.DisplayAlerts = False
 Application.ScreenUpdating = False

 '********* STARTS EMAIL ON LOTUS NOTES *********

Set Notes = CreateObject("Notes.NotesSession") 'Creates Lotus Notes Session
MailDbName = "email.nsf"
Set Maildb = Notes.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL 'Sets database to default mail database
End If
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
Call WorkSpace.ComposeDocument(, , "Memo") 'Creates a memo document (standard email)
Set UIDoc = WorkSpace.CurrentDocument
   

'********** EMAIL DETAILS **********

Send_Recipients = "EMAIL@EMAIL.COM" 'Recipients

Email_Subject = "Subject: Trying to paste bitmap and add 'prevent copying' on draft" 'Email subject

Call UIDoc.FieldSetText("enterSendTo", Send_Recipients) 'Recipients

Call UIDoc.FieldSetText("Subject", Email_Subject) 'Email subject

Range("B5:C16").CopyPicture (xlBitmap) 'Copies range as bitmap

Call UIDoc.GoToField("Body") 'Goes to the body of the email

Call UIDoc.Paste 'Pastes copied range into the email body as picture

Application.CutCopyMode = False

'UIDoc.ReplaceItemValue "$KeepPrivate", "1" 'Adds prevent copying (**NOT WORKING**)

Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox ("Email successfully created as draft")

Set Send_Recipients = Nothing
Set Email_Subject = Nothing
Set Notes = Nothing
Set WorkSpace = Nothing
Set UIDoc = Nothing
Set MailDbName = Nothing

End Sub

 

[John_w]

Try this (change the cells range and email addresses to suit):

Sub Create_Draft_Email()

    Dim Session As Object, Workspace As Object, UIDoc As Object
    Dim Subject As String, SendTo As String, CopyTo As String
    Dim insertCells As Range
    
    Set insertCells = Range("A1:C6")        'CELLS TO BE INSERTED IN EMAIL
    SendTo = "email.address1@email.com, email.address2@email.com"
    CopyTo = "copy.me@email.com"
    Subject = Now & " Lotus Notes email"
    
    Set Workspace = CreateObject("Notes.NotesUIWorkspace")
    Workspace.ComposeDocument , , "Memo"
    
    Set UIDoc = Workspace.currentdocument
    With UIDoc
        .FieldSetText "EnterSendTo", SendTo
        .FieldSetText "EnterCopyTo", CopyTo
        .FieldSetText "Subject", Subject
        
        .GotoField "Body"
        .InsertText "Email body text." & vbLf & vbLf
        .InsertText "Excel cells are below:" & vbLf & vbLf
        
        'Copy and paste Excel cells as a picture
        
        insertCells.CopyPicture xlBitmap
        .Paste
        Application.CutCopyMode = False
        
        .InsertText vbLf & vbLf & "End of email body text."
        
        'Set the 'Prevent Copying' flag
        
        .FieldSetText "$KeepPrivate", "1"

        'Close the UI document
        
        .Close
    End With
    
    'Send V key for the 'Save Only' button to save in Drafts
    
    AppActivate "Send Mail"
    SendKeys "V"
    
    Set UIDoc = Nothing
    Set Workspace = Nothing
    
End Sub

 

[abreu]

John,

Thanks for your swift response. The Prevent Copying part worked great, and that was the main problem I was struggling with. However, although the whole code ran without any problem, in the end, after running "UIDoc.Close", I couldn't get the message box in Lotus Notes to close. I had to manually select the Lotus Notes window and hit "V" to get it to work. Would you have any other thoughts on how to save the message and close the message box?

Additionally, if it's not too much to ask, do you know how could I add attachments to the email using the code you posted?

Many thanks

 

[abreu]

Actually, I ran the code all at once now, and I keep getting the following error when it gets to 'SendKeys "V"': "Run-time error '5': Invalid procedure call or argument"

I guess this error didn't appear before because I was running the code with F8 (debugging), and therefore I always had the Excel window activated...

 

[John_w]

The code works for me on Notes 6.5, in the VB debugger and when run from a command button on a sheet. The AppActivate and SendKeys parts of the code make a couple of assumptions:

1. 'Send Mail' is the title of the LN window with the 5 buttons: Send & Save, Send Only, Save Only, Discard, and Cancel. Change this string if it's different on your system.

2. V or v is the shortcut key for the Save Only button. Press the Alt key when the window is displayed manually and see which character is underlined. On my system, the 'v' in Save Only is underlined.

Try changing that part of the code to:

    Application.Wait Now + TimeSerial(0, 0, 1)
    AppActivate "Send Mail", True
    SendKeys "V"

You might need to increase the wait time.

For the attachment, I think you'll need to create the mail document in memory first using NotesDocument, add attachment(s) in a NotesRichTextItem, then edit the document using the NotesUIDocument technique shown.

 

[abreu]

I'm using Notes 8.5 and both assumptions mentioned are the same for me.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
The time increase worked well when I run one code at a time, but when I run a code which calls several other codes (emails), then sometimes the dialog box is still shown for some emails. I guess this is a bug or the time would have to increase a bit more, but then it would slow down my code a little. I might just end up leaving the email open as draft, instead of saving and sending it to the drafts folder.<o></o>
<o></o>
Concerning the attachments, I searched a few code examples and came up with this one, which saves it in my drafts folder with no problem. However, it doesn’t keep the user’s signature to it. I’ve tried a few codes online, but none of them worked properly for me. Do you know a way of adding it?<o></o>
<o></o>
Again, I appreciate your time and help!<o></o>
<o></o>

<o:p></o:p>
Sub Email_Attachment()<o:p></o:p>
<o:p></o:p>
Dim UserName As String<o:p></o:p>
Dim Maildb As Object<o:p></o:p>
Dim MailDoc As Object<o:p></o:p>
Dim AttachME As Object<o:p></o:p>
Dim Session As Object<o:p></o:p>
Dim EmbedObj1 As Object<o:p></o:p>
<o:p></o:p>
Set Session = CreateObject("Notes.NotesSession")<o:p></o:p>
Set Maildb = Session.GETDATABASE("mail", "Mail\mail.nsf")<o:p></o:p>
If Maildb.IsOpen = True Then<o:p></o:p>
Else<o:p></o:p>
Maildb.OPENMAIL<o:p></o:p>
End If<o:p></o:p>
<o:p></o:p>
Set MailDoc = Maildb.CREATEDOCUMENT<o:p></o:p>
<o:p></o:p>
With MailDoc<o:p></o:p>
.form = "Memo"<o:p></o:p>
.sendto = "mail@mail.com"<o:p></o:p>
.copyto = "mail@mail.com"<o:p></o:p>
.Subject = "subject "<o:p></o:p>
End With<o:p></o:p>
<o:p></o:p>
attachment1 = "h:attachment.xls"<o:p></o:p>
<o:p></o:p>
If attachment1 <> "" Then<o:p></o:p>
Set AttachME = MailDoc.CreateRichTextItem("attachment1")<o:p></o:p>
Set EmbedObj1 = AttachME.EmbedObject(1454, "attachment1", attachment1, "")<o:p></o:p>
End If<o:p></o:p>
<o:p></o:p>
Call MailDoc.Save(False, False) 'Saves emails as draft<o:p></o:p>
<o:p></o:p>
Set Maildb = Nothing<o:p></o:p>
Set MailDoc = Nothing<o:p></o:p>
Set AttachME = Nothing<o:p></o:p>
Set Session = Nothing<o:p></o:p>
Set EmbedObj1 = Nothing<o:p></o:p>
<o:p></o:p>
MsgBox ("Email successfully created as draft")<o:p></o:p>
<o:p></o:p>
End Sub<o:p></o:p>
<o:p></o:p>

<o></o>
<o></o>

 

[John_w]

Concerning the attachments, I searched a few code examples and came up with this one, which saves it in my drafts folder with no problem. However, it doesn’t keep the user’s signature to it. I’ve tried a few codes online, but none of them worked properly for me. Do you know a way of adding it?

I've only managed to include the automatic signature when creating a document using the front-end NotesUIDocument class via the Workspace.ComposeDocument method, as my code does. The problem is that NotesUIDocument can't add attachments; for that you must use NotesDocument and NotesRichTextItem or HTML and NotesMIMEEntity object(s). One solution is to use both NotesUIDocument and NotesDocument in tandem, and I found this which has several code examples:

http://webcache.googleusercontent.c...esdocument+createdocument+automatic+signature

A better solution though is the suggestion in that thread to read the signature fields from the CalendarProfile profile document, and avoid the use of NotesUIDocument altogether.

 

[abreu]

Same thing with me. I've tried so many different codes and combinations, but I can only get the signature to work through the front-end mode. The closest I've gotten to add attachments and still have the signature in the email is with the solution you mentioned I tried:

sigText = maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)

But the variable sigText keeps empty.

The most helpful website I found on this matter so far is Notes official website: https://www-304.ibm.com/support/docview.wss?uid=swg21448083. It shows some changes to the signature mode in Notes 8.5, but I still have no clue on how to adapt the code. Maybe a quick look at it and an expert might solve it.

I'll keep looking for a solution to it. If I have any news, I'll let you know. Thanks again!

 

[John_w]

Here is my code combined with Bill-Hanson's answer in the thread I linked to. It works on Notes 6.5 and does everything you asked for: insert Excel cells as a bitmap, include a file attachment, set the 'Prevent Copying' flag, include the automatic signature, and save the email in the Drafts folder.

The only things you should need to change to test it on your system are the email addresses and the file name of the attachment.

Option Explicit

Sub Test_Notes_Email()

    Dim subject As String, sendTo As String, copyTo As String
    Dim insertCells As Range
    Dim fileAttachment As String
    
    Set insertCells = Range("A1:C6")     'Cells to be inserted as a bitmap
    
    sendTo = "email.address1@email.com, email.address2@email.com"
    copyTo = "copy.address@email.com"
    subject = Now & " Lotus Notes email"    
    fileAttachment = "C:\path\to\myfile.txt"

    Create_Draft_with_Cells_Attachment_Signature subject, sendTo, copyTo, insertCells, fileAttachment
    
End Sub


Private Sub Create_Draft_with_Cells_Attachment_Signature(subject As String, sendTo As String, copyTo As String, cells As Range, filePath As String)

    Dim NSession As Object
    Dim NWorkspace As Object
    Dim NDb As Object
    Dim NDocumentTemp As Object
    Dim NUIDocumentTemp As Object
    Dim NUIDocument As Object
    Dim NRichTextBody As Object
    Dim BodyText As String
    
    Const EMBED_ATTACHMENT = 1454
   
    BodyText = "This is the email body text." & vbLf & vbLf & _
        "Excel cells are below:" & vbLf & vbLf & _
        "***MARKER TEXT***" & vbLf & vbLf & _
        "End of body text."
   
    Set NSession = CreateObject("Notes.NotesSession")   'OLE (late binding only) because we access UI classes
    Set NWorkspace = CreateObject("Notes.NotesUIWorkspace")
    Set NDb = NSession.GetDatabase("", "")
    NDb.OpenMail
   
    'Create a temporary NotesDocument
    
    Set NDocumentTemp = NDb.CreateDocument
    With NDocumentTemp
        .Form = "Memo"
        
        'Add a rich text item to contain the email body text and file attachment
        
        Set NRichTextBody = .CreateRichTextItem("Body")
        With NRichTextBody
            .AppendText BodyText
            If filePath <> "" Then
                .AddNewLine 2
                .AppendText filePath & " attached"
                .AddNewLine 2
                .EmbedObject EMBED_ATTACHMENT, "", filePath
                .AddNewLine 1
            End If
        End With
        
        .Save False, False
    End With
   
    'Display the temporary document in the UI
    
    Set NUIDocumentTemp = NWorkspace.EditDocument(True, NDocumentTemp)
   
    'Copy the rich text to the clipboard, close the window, and delete the temp doc
    
    With NUIDocumentTemp
        .GotoField "Body"
        .SelectAll
        .Copy
        .Document.SaveOptions = "0" 'prevent prompt
        .Document.MailOptions = "0" 'prevent prompt
        .Close                      'therefore temp UI doc not saved
    End With
    NDocumentTemp.Remove True

    'Compose the real email document
    
    Set NUIDocument = NWorkspace.ComposeDocument(NDb.Server, NDb.filePath, "Memo")
    With NUIDocument
        .FieldSetText "EnterSendTo", sendTo
        .FieldSetText "EnterCopyTo", copyTo
        .FieldSetText "Subject", subject

        'Set the 'Prevent Copying' flag
        
        .FieldSetText "$KeepPrivate", "1"
        
        'The memo now has everything but the rich text from the temporary UI document.  The automatic signature should be at the
        'bottom of the memo.  Now, we just paste the rich text into the body
        
        .GotoField "Body"
        .Paste
   
        'Replace the marker text with the Excel cells pasted as a bitmap
        
        .GotoField "Body"
        .FindString "***MARKER TEXT***"
        cells.CopyPicture xlBitmap
        .Paste
        Application.CutCopyMode = False

        'Close the UI document.  This opens a dialogue with caption 'Send Mail' and 5 buttons: Send & Save, Send Only, Save Only, Discard, Cancel
        
        .Close
    End With
    
    'Click 'Save Only' button to save mail document in Drafts
    
    Application.Wait Now + TimeSerial(0, 0, 1)
    AppActivate "Send Mail", True
    SendKeys "V"
   
End Sub

 

[abreu]

That works perfectly! I'll now switch all my email codes to this one, as it's by far the most flexible and broaden I've seen. Actually, I tested creating several emails at once (one sub calling several others) and sometimes - only sometimes - the dialog box in Notes still kept open, even after increasing the delay. But this is a minor problem, and it's probably one from Notes. I'll just keep the email memos open and ready to be sent.

Thanks a lot for the code! I appreciate it.