Paste Lotus Notes email body to Word Document

Option Explicit


Public Sub Copy_and_Paste_Notes_Email()
   
    Dim NSession As Object
    Dim NUIWorkSpace As Object
    Dim NUIDoc As Object
    
    Set NSession = CreateObject("Notes.NotesSession")
    Set NUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
    
    Set NUIDoc = NUIWorkSpace.EditDocument
    If Not NUIDoc Is Nothing Then
        NUIDoc.GotoField "Body"
        NUIDoc.SelectAll
        NUIDoc.Copy
        NUIDoc.Close True       'True = immediate
        Paste_To_Word_Document
    Else
        MsgBox "Lotus Notes is not displaying an email, therefore unable to copy email body"
    End If
    
    Set NUIDoc = Nothing
    Set NUIWorkSpace = Nothing
    Set NSession = Nothing
    
End Sub




Private Sub Paste_To_Word_Document()


    Dim WordApp As Object
    Dim WordDoc As Object
    Dim WordRange As Object
    
    'Get the active Word document, if any
    
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    On Error GoTo 0
    
    If WordApp Is Nothing Then
    
        'A Word document isn't open, so open a new document
        
        Set WordApp = CreateObject("Word.Application")
        WordApp.Visible = True
        WordApp.Documents.Add
            
    End If
    
    Set WordDoc = WordApp.ActiveDocument
    
    'Code for pasting clipboard into 3 different positions in Word document
    
    '1. Paste clipboard to Word document, replacing existing contents
    
    'WordDoc.Range.PasteAndFormat Type:=0           '0 = WdRecoveryType.wdPasteDefault
        
    '2. Paste clipboard to end of Word document
    
    Set WordRange = WordApp.ActiveDocument.Content
    WordRange.Collapse Direction:=0                '0 = WdCollapseDirection.wdCollapseEnd
    WordRange.Paste
    
    '3. Paste clipboard at cursor position in Word document
    
    'WordApp.Selection.Paste
    
    Application.CutCopyMode = False
        
End Sub