Try this code as a starting point for creating a more sophisticated macro for your needs. It looks for an email in the Lotus Notes Inbox with the specified subject and forwards it to the specified email address(es). It uses the VBA Like operator to find the email and therefore the subject can contain wildcards:
Office VBA reference topic
docs.microsoft.com
For example, the Test routine uses the * wildcard, so it finds the first email which starts with "Subject text".
Note that the code uses Lotus UI objects so Notes must be open and Mail must be the active tab.
VBA Code:
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As LongPtr) As LongPtr
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)
Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
#End If
Public Sub Test()
Forward_Email "Subject text*", "email1@address.com,email2@address.com"
End Sub
Public Sub Forward_Email(findSubjectLike As String, forwardToEmailAddresses As String)
Dim NSession As Object
Dim NMailDb As Object
Dim NViewObj As Variant
Dim NInboxView As Object
Dim NDocument As Object
Dim NUIWorkspace As Object 'All Lotus front-end UI classes are OLE only and must be declared As Object
Dim NUIDocument As Object
Dim NFwdUIDocument As Object
Set NSession = CreateObject("Notes.NotesSession") 'OLE - late binding only
Set NUIWorkspace = CreateObject("Notes.NotesUIWorkspace")
Set NMailDb = NSession.CurrentDatabase
'Find Inbox folder (view)
For Each NViewObj In NMailDb.Views
If NViewObj.IsFolder And NViewObj.Name = "($Inbox)" Then
Set NInboxView = NViewObj
Exit For
End If
Next
'Find NotesDocument email in Inbox folder (view) with the specified subject
Set NDocument = Find_Document(NInboxView, findSubjectLike)
If Not NDocument Is Nothing Then
'Open the email for read only in the Notes UI
Set NUIDocument = NUIWorkspace.EditDocument(False, NDocument)
'Forward the email, creating a new document in the UI
NUIDocument.Forward
'Get the new document to be forwarded
Set NFwdUIDocument = NUIWorkspace.CurrentDocument
'Enter To email address(es) (comma-separated)
NFwdUIDocument.GoToField "To"
NFwdUIDocument.InsertText forwardToEmailAddresses
'Enter text in email body
NFwdUIDocument.GoToField "Body"
NFwdUIDocument.InsertText "This email was forwarded at " & Now
NFwdUIDocument.InsertText vbLf
'Send and close the forwarded document - the email is put in the Sent folder
NFwdUIDocument.Send
NFwdUIDocument.Close
'Close the existing document, which is still open (read only) in the Notes UI
Do
Set NUIDocument = NUIWorkspace.CurrentDocument
Sleep 100
DoEvents
Loop While NUIDocument Is Nothing
NUIDocument.Close
Else
MsgBox "Email with the subject like " & vbCrLf & findSubjectLike & vbCrLf & "not found in Inbox"
End If
Set NUIDocument = Nothing
Set NFwdUIDocument = Nothing
Set NDocument = Nothing
Set NMailDb = Nothing
Set NUIWorkspace = Nothing
Set NSession = Nothing
End Sub
'Find the document in a View which matches the specified subject
Private Function Find_Document(NView As Object, findSubjectLike As String) As Object
Dim NThisDoc As Object
Dim thisSubject As String
Set Find_Document = Nothing
Set NThisDoc = NView.GetFirstDocument
While Not NThisDoc Is Nothing And Find_Document Is Nothing
thisSubject = NThisDoc.GetItemValue("Subject")(0)
If LCase(thisSubject) Like LCase(findSubjectLike) Then Set Find_Document = NThisDoc
Set NThisDoc = NView.GetNextDocument(NThisDoc)
Wend
End Function
