Copy from Lotus note body in mail to excel cells.

abjac · Nov 14th 2014

HI. All.

I need an excel macro to get different data from lotus notes text body and paste it into excel cells. I've looked hard searching through the Internet but it seems as is everybody is only interested in sending e-mails but not getting text data. Hope someone can help out here.
So I guess this is a one of the hard ones.

I found below code but in my excel 2003 I never reach to be able to test it, it give me errors.
But maybe some of the experts here can use it or change it or maybe some know another code to use.
Because of limited user who knows about lotus notes its cross posted in hope of some knows how to help with this.http://www.excelforum.com/exce…-mail-to-excel-cells.html
http://www.mrexcel.com/forum/e…el-cells.html#post3994441
Thanks in advance.

Sincerely

Abjac

My found not working code.

Code

Sub Initialize


    On Error Resume Next
    
    Dim dbSession             As New NotesSession
    Dim db                          As NotesDatabase
    Dim curView                  As NotesView
    Dim StatDoc                  As NotesDocument
    Dim ExcelPath             As String
    Dim ExcelFileName     As String
    Dim MSAction             As String
    Dim path                     As String
    Dim oExcel                 As Variant
    Dim oWorkbook             As Variant
    Dim openExcel             As Integer
    
'connect to the current opened Database
    Set db = dbSession.CurrentDatabase
    
'set the current view, filename and refresh
    Set curView = db.GetView ( "All")
    DefaultFileName$="c:\All"+".xls"
    Call curView.Refresh
    If curView Is Nothing Then
        Messagebox "View does not exist"
        End 
    End If
    
'get the first document in the view and check for an empty view
    Set StatDoc = curView.GetFirstDocument
    If StatDoc Is Nothing Then
        Messagebox "Current View is empty."
        End
    End If
    
    Set oExcel = CreateObject ( "Excel.Application" )
    
    ExcelPath = DefaultPath$
    
    path = oExcel.Path
    oExcel.Quit
    Set oExcel = Nothing
    
    Call ExportToExcel ( ExcelPath, DefaultFileName$, curView)
    If Instr ( ExcelFileName, " " ) > 0 Then
        DefaultFileName$ = {"} & DefaultFileName$ & {"}
    End If
    openExcel = Shell ( path & "\excel.exe " &DefaultFileName$, 3 )
    
exit_sub:
    If Not oExcel Is Nothing Then
        oExcel.Quit
        Set oExcel = Nothing
    End If
    
    Exit Sub
    
End Sub


Sub ExportToExcel ( ExcelPath As String, ExcelFileName As String, curView As NotesView)
    
    Dim curDoc                 As NotesDocument
    Dim oExcel                 As Variant
    Dim oWorkbook            As Variant
    Dim oWorkSheet         As Variant
    Dim i                         As Double
    
    On Error Resume Next
    
'Automate Excel, add a workbook and a worksheet    
    'Set oExcel = CreateObject ( "Excel.Application" )
    Set oExcel = CreateObject("Excel.Application")
    'Set oWorkbook = oExcel.Workbooks.Add(1)
    'Set oWorkSheet= oWorkbook.Sheets ( 1 )
    Set oWorkbook = oExcel.Workbooks.Open("C:\All.xls")
    If Err Then
        Msgbox "here"
        Set oWorkbook = oExcel.Workbooks.Add(1)
        oWorkbook.SaveAs ( "C:\All.xls" )
    End If
    
    Set oWorkSheet= oWorkbook.Sheets ( "Sheet1" )
    
    'Set oWorksheet = oWorkbook.Worksheets(1)
    'oExcel.Cells(1, 1).Value = 11
    'oWorkbook.WorkSheets(1).Range("A1").Value = "TEST"
    'oWorkSheet.Range("A1").Value = "AAAA"    
    'oExcel.Visible = True
    
    oWorkSheet.Cells.Select
    oWorkSheet.Range("A1:M10000").ClearContents
    
    'End 
    
'Start reading information in the view. If view is empty, then quit
    Set curDoc = curView.GetFirstDocument
    If curDoc Is Nothing Goto exit_sub
    
'This section adds headings in row 2    
    oWorkSheet.Range("A1").Value = "Requested by"
    oWorkSheet.Range("B1").Value = "Analyst"
    oWorkSheet.Range("C1").Value = "Date Created"
    oWorkSheet.Range("D1").Value = "Est. Start Date"
    oWorkSheet.Range("E1").Value = "Act Start Date"
    oWorkSheet.Range("F1").Value = "Est. Complete Date"
    oWorkSheet.Range("G1").Value = "Actual Complete Date"
    oWorkSheet.Range("H1").Value = "Category"
    oWorkSheet.Range("I1").Value = "Department"
    oWorkSheet.Range("J1").Value = "Summary"
    oWorkSheet.Range("K1").Value = "Request Title"
    oWorkSheet.Range("L1").Value = "Comments"
    oWorkSheet.Range("M1").Value = "Status"
    oWorkSheet.Range("N1").Value = "Priority"
    oWorkSheet.Range("O1").Value = "Work Weeks"
    oWorkSheet.Range("P1").Value = "Process Name"
    oWorkSheet.Range("Q1").Value = "Process Owner"
    oWorkSheet.Range("R1").Value = "User Priority"
    oWorkSheet.Range("S1").Value = "Management Sponsor"
    oWorkSheet.Range("T1").Value = "Team / Resources"
    oWorkSheet.Range("U1").Value = "Root Cause"
    oWorkSheet.Range("V1").Value = "Proposed Solution"
    oWorkSheet.Range("W1").Value = "Alternatives"
    oWorkSheet.Range("X1").Value = "Target Implementation Date"
    oWorkSheet.Range("Y1").Value = "Estimated Costs (out of pocket)"
    oWorkSheet.Range("Z1").Value = "Estimated Costs (internal)"
    oWorkSheet.Range("AA1").Value = "Business Benefits"
    oWorkSheet.Range("AB1").Value = "Post Implementation KPIs"
    
    
'The first row that will contain view data is 2    
    i = 2    
    
    Do Until curDoc Is Nothing
        
'This section adds the view information to excel
        oWorkSheet.Range ( "A" & i  ).Value = curDoc.txtCreator(0)
        oWorkSheet.Range ( "B" & i  ).Value = curDoc.cmbAnalyst(0)
        oWorkSheet.Range ( "C" & i ).Value = curDoc.dtDateCreated(0)
        oWorkSheet.Range ( "D" &  i  ).Value = curDoc.dtEstStartDate(0)
        oWorkSheet.Range ( "E" & i  ).Value = curDoc.dtActStartDate(0)
        oWorkSheet.Range ( "F" &  i  ).Value = curDoc.dtEstCompDate(0)
        oWorkSheet.Range ( "G" &  i  ).Value = curDoc.dtActCompDate(0)
        oWorkSheet.Range ( "H" &  i  ).Value = curDoc.dlCategory(0)
        oWorkSheet.Range ( "I" & i  ).Value = curDoc.dlDepartment(0)
        oWorkSheet.Range ( "J" & i  ).Value = curDoc.rtBRAB(0)
        oWorkSheet.Range ( "K" & i  ).Value = curDoc.txtRequestTitle(0)
        oWorkSheet.Range ( "L" & i  ).Value = curDoc.rtComments(0)
        oWorkSheet.Range ( "M" & i  ).Value = curDoc.txtOCStatus(0)
        oWorkSheet.Range("N" & i).Value = curDoc.txtPriority(0)
        oWorkSheet.Range("O" & i).Value = curDoc.txtEstWorkWeek(0)
        oWorkSheet.Range("P" & i).Value = curDoc.txtProcessName(0)
        oWorkSheet.Range("Q" & i).Value = curDoc.txtProcessOwner(0)
        oWorkSheet.Range("R" & i).Value = curDoc.cmbUserPriority(0)
        oWorkSheet.Range("S" & i).Value = curDoc.txtSponsor(0)
        oWorkSheet.Range("T" & i).Value = curDoc.txtTeamResources(0)
        oWorkSheet.Range("U" & i).Value = curDoc.txtRootCause(0)
        oWorkSheet.Range("V" & i).Value = curDoc.txtProposedSolution(0)
        oWorkSheet.Range("W" & i).Value = curDoc.txtAlternatives(0)
        oWorkSheet.Range("X" & i).Value = curDoc.dtTargetImpDate(0)
        oWorkSheet.Range("Y" & i).Value = curDoc.txtOutOfPocket(0)
        oWorkSheet.Range("Z" & i).Value = curDoc.txtInternal(0)
        oWorkSheet.Range("AA" & i).Value = curDoc.txtEstBenefits(0)
        oWorkSheet.Range("AB" & i).Value = curDoc.txtPostImpKPIs(0)
        
'Increment to the next row
        i = i + 1
        
'Increment to the next document        
        Set curDoc = curView.GetNextDocument ( curDoc )
        
    Loop
    
Exit_Sub:
'Take our objects out of memory, save file, and quit excel
    Set oWorkSheet= Nothing
    oWorkbook.Save
    Set oWorkbook = Nothing
    oExcel.Quit
    Set oExcel = Nothing    
End Sub

Display More

John_w · Nov 14th 2014

Re: Copy from Lotus note body in mail to excel cells.

See if this gets you started. It loops through all emails in the Lotus Notes Inbox and displays the email body text. You would need to modify the code slightly to extract the text into Excel cells.

Code

Public Sub Get_Notes_Email_Text()


    Dim NSession As Object      'NotesSession
    Dim NMailDb As Object       'NotesDatabase
    Dim NDocs As Object         'NotesDocumentCollection
    Dim NDoc As Object          'NotesDocument
    Dim NNextDoc As Object      'NotesDocument
    Dim NItem As Object         'NotesItem
    Dim view As String
    Dim filterText As String
    
    view = "$All"       'Name of view or folder to retrieve documents from
    view = "$Inbox"
    filterText = ""     'Optional text string to filter the view
    
    Set NSession = CreateObject("Notes.NotesSession")
    Set NMailDb = NSession.GetDatabase("", "")  'Default server and database


    If Not NMailDb.IsOpen Then NMailDb.OpenMail
    
    Set NDocs = NMailDb.GetView(view)
    NDocs.Clear
        
    'Apply optional filter
        
    If filterText <> "" Then
        NDocs.FTSearch filterText, 0
    End If
      
    Set NDoc = NDocs.GetFirstDocument
    Do Until NDoc Is Nothing
        Set NNextDoc = NDocs.GetNextDocument(NDoc)
        Set NItem = NDoc.GetFirstItem("Body")
        If Not NItem Is Nothing Then
            MsgBox prompt:=NItem.Text, Title:=NDoc.GetItemValue("Subject")(0)
        End If
        Set NDoc = NNextDoc
    Loop
    
    NMailDb.Close
    NSession.Close
    
    Set NSession = Nothing


End Sub

Display More

abjac · Nov 14th 2014

Re: Copy from Lotus note body in mail to excel cells.

Hi. John. Wow it really open all the mails body text in the inbox and display it in notepad. Could you please help so it only open the mail which is open. That's how I need it. Please see if you can change it to only open the mail which is open. Then I will try work with to get it to excel instead of notepad. But its a start for sure and the first one in many places so thanks allot for now. But need help I think to get it to open only the mail which is open.If you could have a look at that it will be great. Sincerely Abjac

John_w · Nov 14th 2014

Re: Copy from Lotus note body in mail to excel cells.

Try this. It displays the body text of the currently open email.

Code

Public Sub Lotus_Notes_Current_Email()


    Dim NSession As Object      'NotesSession
    Dim NUIWorkspace As Object  'NotesUIWorkspace
    Dim NUIDoc As Object        'NotesUIDocument
    Dim NItem As Object         'NotesItem
    
    Set NSession = CreateObject("Notes.NotesSession")
    Set NUIWorkspace = CreateObject("Notes.NotesUIWorkspace")
    
    Set NUIDoc = NUIWorkspace.CurrentDocument
    If Not NUIDoc Is Nothing Then
        With NUIDoc.Document
            Set NItem = .GetFirstItem("Body")
            If Not NItem Is Nothing Then
                MsgBox prompt:=NItem.Text, Title:=.GetItemValue("Subject")(0)
            End If
        End With
    Else
        MsgBox "Lotus Notes is not displaying an email"
    End If
    
    Set NUIDoc = Nothing
    Set NUIWorkspace = Nothing
    Set NSession = Nothing
    
End Sub

Display More

abjac · Nov 14th 2014

Re: Copy from Lotus note body in mail to excel cells.

Hi. John it works really perfect. It do exactly what it have to do. I am still struggling with how to get it into excel from column start A2 instead of going to a message box. If you know and can solve that it would be so perfect. Thanks Sincerely Abjac

John_w · Nov 14th 2014

Re: Copy from Lotus note body in mail to excel cells.

This puts each line of the email body into Excel column A starting at A2.

Code

Public Sub Lotus_Notes_Current_Email2()


    Dim NSession As Object      'NotesSession
    Dim NUIWorkspace As Object  'NotesUIWorkspace
    Dim NUIDoc As Object        'NotesUIDocument
    Dim NItem As Object         'NotesItem
    Dim lines As Variant
    
    Set NSession = CreateObject("Notes.NotesSession")
    Set NUIWorkspace = CreateObject("Notes.NotesUIWorkspace")
    
    Set NUIDoc = NUIWorkspace.CurrentDocument
    If Not NUIDoc Is Nothing Then
        With NUIDoc.Document
            Set NItem = .GetFirstItem("Body")
            If Not NItem Is Nothing Then
                lines = Split(NItem.Text, vbCrLf)
                Range("A2").Resize(UBound(lines) + 1, 1).Value = Application.WorksheetFunction.Transpose(lines)
            End If
        End With
    Else
        MsgBox "Lotus Notes is not displaying an email"
    End If
    
    Set NUIDoc = Nothing
    Set NUIWorkspace = Nothing
    Set NSession = Nothing
    
End Sub

Display More

abjac · Nov 14th 2014

Re: Copy from Lotus note body in mail to excel cells.

Hi John Wow. It work just perfect. Its brilliant I have asked about this many places and no answers or nothing found on the internet also. Its brilliant. Thanks allot really great.. Have a nice day. Sincerely Abjac

abjac · Nov 18th 2014

Re: Copy from Lotus note body in mail to excel cells.

Hi. John_W. I have a question your code is really great. But i need to know if its possible to get a table out from the mail. Now i get the body text. But what i have and need is a form in the mail with tables and columns. And this is the one which i need to work with in excel. Is it possible to get this out as a table+
Please if time have a look.

Sincerely

Abjac

John_w · Nov 18th 2014

Re: Copy from Lotus note body in mail to excel cells.

It's difficult to help without me seeing the email body text and how the table is constructed, in terms of characters and bytes. If you run the following code with a LN email open, it creates the file "Email_body.txt" in the same folder as the workbook, containing the email body bytes. If you post this text file here I will be able to see how the table is constructed. Also indicate exactly which bytes are the start and end of the table.

Code

Public Sub Lotus_Notes_Current_Email_File()


    Dim NSession As Object      'NotesSession
    Dim NUIWorkspace As Object  'NotesUIWorkspace
    Dim NUIDoc As Object        'NotesUIDocument
    Dim NItem As Object         'NotesItem
    
    Dim i As Integer, ch As String
    Dim outputFile As String
    
    'Writes email body bytes to a text file
    
    outputFile = ThisWorkbook.Path & "\Email_body.txt"
    
    Set NSession = CreateObject("Notes.NotesSession")
    Set NUIWorkspace = CreateObject("Notes.NotesUIWorkspace")
    
    Set NUIDoc = NUIWorkspace.CurrentDocument
    If Not NUIDoc Is Nothing Then
        With NUIDoc.Document
            Set NItem = .GetFirstItem("Body")
            If Not NItem Is Nothing Then
                            
                Open outputFile For Output As #1
                For i = 1 To Len(NItem.Text)
                    ch = Mid(NItem.Text, i, 1)
                    Print #1, i & " " & IIf(Asc(ch) >= 32 And Asc(ch) <= 126, ch, "<" & Asc(ch) & ">")
                Next
                Close #1
                
            End If
        End With
    Else
        MsgBox "Lotus Notes is not displaying an email"
    End If
    
    Set NUIDoc = Nothing
    Set NUIWorkspace = Nothing
    Set NSession = Nothing
    
End Sub

Display More

abjac · Nov 18th 2014

Re: Copy from Lotus note body in mail to excel cells.

Hi. JOhn thats great i have to wait for tomorrow to get it done because its at my work i have it. But i will take a test with the upper macro. Infact it will be 2 tables nearly the same but not totally. But i will post tomorrow. Thanks allot for taking your time to help with this.

Sincerely
Abjac

abjac · Nov 18th 2014

Re: Copy from Lotus note body in mail to excel cells.

Hi I manage to get them now so here is 2 files. I have to forms which have to be used in 2 different mails/stationary. Please have a look and thanks for looking at this. Its really great. Sincerely abjac

John_w · Nov 19th 2014

Re: Copy from Lotus note body in mail to excel cells.

That's useful. Can you also post screenshot images of the 2 email bodies, including any text above and below each table. That will let me relate the body bytes in the text files to the actual tables.

abjac · Nov 19th 2014

Re: Copy from Lotus note body in mail to excel cells.

Hi. John. I think the submitter of the mail can change the text above the form, so its hard to say how much there will there. Below i guess it will common and will not change. But if i have to provide a complete textfile with screen shot. Could you PM me with you mail address, Its very confidental info which i cant really share here its related to my work.

Text me back what you think
Thanks
Sincerely
Abjac

abjac · Nov 20th 2014

Re: Copy from Lotus note body in mail to excel cells.

HI John i send you the files. But also i think there is another way to handle it. When i use your code to get the body out from lotus mail to excel. It come out in lines. When i have these lines i delete all with a macro so all above the word Country Code is deleted and all below the word Revenue type is deleted. I can use this because then i infact have what i need to work with in the form. I use the text to columns in a macro with other delimiter :.
It nearly works. But in some of the cell in the table there is more words which means they come out in another line in your macro.

My idea could be in you macro which get it to excel to delete all above the Country Code and all under the word Revenue type. After that if its possible to make the output lines so it go to next line when it reach the third(3) : Then i think it would work perfect and quite secure that the out put is correct. I can then just use one macro text to columns with delimitter : and the result will be perfect every time.

The form example

Code

Columns A       Column B                          Column C


Country Code: Mandatory for all countries: 838
Customer nr:   Mandatory:                        01

If there is many words in column B it will put the output text file to a new line in the out put text file.

So if this could be done in below file directly before it copy to excel i really think this could the solution and its secure.

But have look at it and maybe you have other idea.

Sincerely
Abjac

This is the code i talk about when it pull out to excel in a text file.

Code

Public Sub Lotus_Notes_Current_Email2()
     
    Dim NSession As Object 'NotesSession
    Dim NUIWorkspace As Object 'NotesUIWorkspace
    Dim NUIDoc As Object 'NotesUIDocument
    Dim NItem As Object 'NotesItem
    Dim lines As Variant
     
    Set NSession = CreateObject("Notes.NotesSession")
    Set NUIWorkspace = CreateObject("Notes.NotesUIWorkspace")
     
    Set NUIDoc = NUIWorkspace.CurrentDocument
    If Not NUIDoc Is Nothing Then
        With NUIDoc.Document
            Set NItem = .GetFirstItem("Body")
            If Not NItem Is Nothing Then
                lines = Split(NItem.Text, vbCrLf)
                Sheets(1).Activate
                Range("H8").Resize(UBound(lines) + 1, 1).Value = Application.WorksheetFunction.Transpose(lines)
            End If
        End With
    Else
        MsgBox "Lotus Notes is not displaying an email"
    End If
     
    Set NUIDoc = Nothing
    Set NUIWorkspace = Nothing
    Set NSession = Nothing
     
End Sub

Display More

John_w · Nov 21st 2014

Re: Copy from Lotus note body in mail to excel cells.

If you reply to my email with the files I requested I should be able to complete the code. One difficulty is the odd formatting of the table. It uses tab characters to separate each column and CR LF to separate each row. But it also uses CR LF in some cells to put the text in separate lines! That is why some words come out in the wrong row in the Excel cells.

Yash20 · Aug 23rd 2016

Re: Copy from Lotus note body in mail to excel cells.

Hello John,

I know its an old thread but I really needs ur support here.

http://<Snip>

I have copied the body of the Lotus Notes email and tried to paste it into the Word document but it pastes a text/string, I wud need to have all the formatted texts also included while pasting. I tried to post this in many other blogs but hardly got any help.

Awaiting for your favorable response!!!

**cytop** · Aug 23rd 2016

Re: Copy from Lotus note body in mail to excel cells.

If you have a question then feel free to start your own thread explaining your issue fully.

(It seems there is an existing thread)

Copy from Lotus note body in mail to excel cells.

Participate now!

Share