Move Lotus Notes mail to a folder in Lotus Notes through VBA

[Crocus Crow]

Try this. It works for me on Notes 6.5.5. As I suggested, it uses the Domino COM class NotesSession to establish a Notes session:

Set NSession = CreateObject("Lotus.NotesSession")
[vba]Private Const RICHTEXT As Long = 1
Private Const EMBED_ATTACHMENT As Long = 1454


Public Sub Save_and_Remove_File_Attachments_Move_Folder()

Dim NUIWorkspace As Object
Dim NSession As Object
Dim NMailDb As Object
Dim NMoveDocsCollection As Object
Dim NView As Object
Dim NDoc As Object, NNextDoc As Object
Dim NItem As Variant
Dim NAttachment As Variant
Dim NMailDoc As Object
Dim sSendTo As String
Dim sSubject As String
Dim sAttachmentNames As String
Dim sSaveWindowsFolder As String
Dim sUserDB As String, sServerName As String, sNotesSourceFolder As String, sNotesDestinationFolder
Dim sBodyText As String

sNotesSourceFolder = "$Inbox"
sNotesDestinationFolder = "Processed"
sSaveWindowsFolder = "C:\MailDocs\"
sServerName = "" 'local Notes server - change as required
sUserDB = "mailnsf"

sBodyText = "Thank you for your mail."

'Front end UI is only exposed with OLE automation

Set NUIWorkspace = CreateObject("Notes.NotesUIWorkspace")

'Start a Notes session, using Lotus Domino Objects (COM classes)

Set NSession = CreateObject("Lotus.NotesSession") 'COM, late binding
NSession.Initialize "" 'supported in COM only

Set NMailDb = NSession.GETDATABASE(sServerName, sUserDB)
If Not NMailDb.IsOpen Then NMailDb.Open

'Create an empty collection which will contain the documents to be moved from the Notes source folder to the destination folder
'This is a kludge because Notes can't do: Set docCollection = New NotesDocumentCollection

Set NMoveDocsCollection = NMailDb.Search("", Nothing, 0)

'Loop through all documents in source folder

Set NView = NMailDb.GetView(sNotesSourceFolder)
Set NDoc = NView.GetFirstDocument
Do Until NDoc Is Nothing

'Cache next document in case the view changes outside this procedure

Set NNextDoc = NView.GetNextDocument(NDoc)

'Has current document got an attachment?

If NDoc.HasEmbedded Then
Set NItem = NDoc.GetFirstItem("Body")
If NItem.Type = RICHTEXT Then

sSendTo = NDoc.GetItemValue("From")(0)
sSubject = NDoc.GetItemValue("Subject")(0)

Debug.Print "Move: " & sSubject

'Save and remove each attachment

sAttachmentNames = ""
For Each NAttachment In NItem.EmbeddedObjects
If NAttachment.Type = EMBED_ATTACHMENT Then
sAttachmentNames = sAttachmentNames & NAttachment.Name & ", "
ExtractNotesAttachment NAttachment, sSaveWindowsFolder
NAttachment.Remove
End If
Next

'Save the modified document and add it to the collection of documents to be moved

NDoc.Save True, False
NMoveDocsCollection.AddDocument NDoc

'Create and send email to sender

Set NMailDoc = NMailDb.CreateDocument
With NMailDoc
.ReplaceItemValue "Form", "Memo"
.ReplaceItemValue "Subject", "Re: " & sSubject & " - " & Left(sAttachmentNames, Len(sAttachmentNames) - 2)
.ReplaceItemValue "SendTo", sSendTo
.ReplaceItemValue "Body", sBodyText

'The Principal and From fields are required, otherwise the From email address is empty in the received email.
'Note that the @MyNotesDomain string must be present in the Principal field

.ReplaceItemValue "Principal", "Your Name<your.email_address@email.com@YourNotesDomain>" 'CHANGE AS REQUIRED
.ReplaceItemValue "From", "Your Name<your.email_address@email.com>" 'CHANGE AS REQUIRED

.SaveMessageOnSend = True
.Send False
End With

End If
End If

Set NDoc = NNextDoc

Loop

'Move documents from Notes source folder to destination folder

With NMoveDocsCollection
.PutAllInFolder sNotesDestinationFolder, True
.RemoveAllFromFolder sNotesSourceFolder
End With

'Refresh source folder

NUIWorkspace.VIEWREFRESH

Set NMailDoc = Nothing
Set NNextDoc = Nothing
Set NDoc = Nothing
Set NMoveDocsCollection = Nothing
Set NView = Nothing
Set NMailDb = Nothing
Set NSession = Nothing
Set NUIWorkspace = Nothing

End Sub

Private Sub ExtractNotesAttachment(NotesAttachment As Variant, WindowsFolder As String)

'Extract a Notes file attachment to a Windows folder path

'The ExtractFile method can cause the following error:
' Notes error: File is in use by another program

'Therefore we isolate this method in this procedure to handle this possible error by waiting
'and trying again until successful

On Error Resume Next
Do
Err.Clear
NotesAttachment.ExtractFile WindowsFolder & NotesAttachment.Name

If Err.Number <> 0 Then
'Debugging info only
Debug.Print "Err.Number = " & Err.Number
Debug.Print "Err.Description = " & Err.Description
Debug.Print "Err.LastDllError = " & Err.LastDllError
End If

If Err.Number <> 0 Then Application.Wait Now + TimeValue("00:00:00.20")
Loop Until Err.Number = 0
On Error GoTo 0

End Sub
[/vba]A word or two on some of the techniques used.

I found that moving documents one by one caused documents to be skipped. Therefore instead of moving each document in the loop, it adds them to a collection which is moved as a whole outside the loop.

Another 'gotcha' is that sometimes the ExtractFile method can cause the following error:

Notes error: File is in use by another program.

This potential error is handled by calling ExtractFile in a separate procedure which contains an On Error handler which waits and tries again until the file is successfully extracted. This error probably occurred in my testing because all my test documents (emails) have the same file attachments and it's possible that the Windows disk i/o was still busy saving the file for the previous Notes document file when it tried to save the same file for the next Notes document.