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
Code
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnTime dTime, "Lotus_Notes_Current_Email2", "Send_Lotus_Email2", False
End Sub
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:01"), "Lotus_Notes_Current_Email2", "Send_Lotus_Email2"
End SubAnd 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 SubAnd 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