Hi,
I am working on following code to read the new email from a particular mail id (ie. [email protected]) or search for particular mail in which its subject contains the text as "New Instruction" if arrived with current date and time of system then the body of the mail will be pasted in excel sheet and send it automatically. Anyhow, I am unable to do so, please help me on the following code to work.
I have used the following code on sheet to run the below two macros automatically
And code to search particular e-mail from the inbox and paste it into the excel.
Code
- Public Sub Lotus_Notes_Current_Email2()
- 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 = "$Inbox" 'Name of view or folder to retrieve documents from
- filterText = "New Instruction" '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
- End If
- 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")
- Set NUIDoc = NUIWorkspace.NItem
- 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("Email").Range("A1").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
- Loop
- End Sub
And code to send the email.
Code
- Public Sub Send_Lotus_Email2()
- Dim NSession As Object
- Dim NWorkspace As Object
- Dim NMailDb As Object
- Dim NUIDocument As Object
- Dim Subject As String
- Dim SendTo As String, CopyTo As String, BODYeX As String
- Dim attachmentFile As String
- Dim embedCells As Range
- Dim lastCellRowNumber As Long
- '------------ User-defined settings section ------------
- SendTo = "[email protected]"
- CopyTo = "[email protected]"
- Subject = "Mizuho Global e-Banking Transaction"
- BODYeX = "Transaction Details are as follows:-"
- With Worksheets("Main")
- Set embedCells = .Columns("A:D")
- End With
- '------------ End of user-defined settings ------------
- Set NSession = CreateObject("Notes.NotesSession") 'OLE, late binding only
- Set NWorkspace = CreateObject("Notes.NotesUIWorkspace")
- Set NMailDb = NSession.GETDATABASE("", "")
- NMailDb.OPENMAIL
- NWorkspace.ComposeDocument , , "Memo"
- Set NUIDocument = NWorkspace.CurrentDocument
- With NUIDocument
- .FieldSetText "EnterSendTo", SendTo
- .FieldSetText "EnterCopyTo", CopyTo
- .FieldSetText "EnterBlindCopyTo", ""
- .FieldSetText "Subject", Subject
- .GotoField "Body"
- '------------ Start of email body text ------------
- .InsertText " ", BODYeX
- Sheets("Main").Range("A1:D2").Copy 'CHANGE THIS
- .Paste
- End With
- NUIDocument.PostedDate = Now()
- NUIDocument.SEND 0, Recipient
- Set NUIDocument = Nothing
- Set NWorkspace = Nothing
- Set NMailDb = Nothing
- Set NSession = Nothing
- End Sub