Originally Posted by
Kenneth Hobs
I won't be in the office until Friday next week. I had similar problems. This does copy the attachments though. If you comment and uncomment the objects for early and late binding, you can use intellisense to explore some methods and properties.
[vba]Sub Test_Save_RemoveAttachments()
Save_Remove_Attachments "mail\khobson.nsf", "C:\MyFiles\Lotus\Notes\Attachments\", "Processed"
End Sub
'Similar to: 'http://www.rondebruin.nl/notes1.htm
Sub Save_Remove_Attachments(theNSF As String, stPath As String, lnPutInFolder As String)
'Late Bind
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noNextDocument As Object
Dim noView As Object
'Early Bind - Tools > Reference > Lotus Notes Automation Classes, notes32.tlb
' Dim noSession As lotus.NOTESSESSION
' Set noSession = CreateObject("Notes.NotesSession")
' Dim noDatabase As lotus.NOTESDATABASE
' Set noDatabase = noSession.GETDATABASE("", "mail\username.nsf")
' Dim noDocument As lotus.NOTESDOCUMENT
' Dim noNextDocument As lotus.NOTESDOCUMENT
' Set noNextDocument = noDatabase.CREATEDOCUMENT
' Dim noView As lotus.NOTESVIEW
Dim EMBED_ATTACHMENT As Long
Dim RICHTEXT As Long
'Embedded objects are of the datatype Variant.
Dim vaItem As Variant
Dim vaAttachment As Variant
EMBED_ATTACHMENT = 1454
RICHTEXT = 1
'Exit if storage path for attachments, stPath, does not exist.
If Right(stPath, 1) <> "\" Then stPath = stPath & "\"
If Dir(stPath, vbDirectory) = "" Then
MsgBox stPath & vbLf & "Macro is ending!", vbCritical, "Storage Path Does Not Exist!"
Exit Sub
End If
'Instantiate the Notes session.
Set noSession = CreateObject("Notes.NotesSession")
'Instantiate the actual Notes database.
'(Here is the personal e-mail database used and since it's a
'local database no reference is made to any server.)
Set noDatabase = noSession.GETDATABASE("", theNSF)
If noDatabase.IsOpen = False Then
noDatabase.OPENMAIL
End If
'Folders are views in Lotus Notes and in this example the Inbox is used.
Set noView = noDatabase.GetView("($Inbox)")
On Error GoTo err_h
'Get the first document in the defined view.
Set noDocument = noView.GetFirstDocument
'Iterate through all the e-mails in the view Inbox.
Do Until noDocument Is Nothing
'Although the following approach is not necessary for this
'kind of operations it may be a good approach to use in general.
Set noNextDocument = noView.GetNextDocument(noDocument)
'Check if the document has an attachment or not.
If noDocument.HasEmbedded Then
Set vaItem = noDocument.GetFirstItem("Body")
If vaItem.Type = RICHTEXT Then
For Each vaAttachment In vaItem.EmbeddedObjects
If vaAttachment.Type = EMBED_ATTACHMENT Then
'Save the attached file into the new folder and remove it from the e-mail.
With vaAttachment
.ExtractFile stPath & vaAttachment.Name
.Remove
End With
'Save the e-mail in order to reflect the deleting of the attached file.
'(A more sophisticated approach may be considered if several e-mails have
'several attachments in order to avoid a repeately saving of one e-mail.)
noDocument.Save True, False, True
noDocument.PUTINFOLDER lnPutInFolder, True
noDocument.REMOVEFROMFOLDER "($Inbox)", True
End If
Next vaAttachment
End If
End If
Set noDocument = noNextDocument
Loop
'Release objects from memory.
Set noNextDocument = Nothing
Set noDocument = Nothing
Set noView = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
MsgBox "All the attachments in the Inbox have successfully been saved and removed." _
, vbInformation
'Clean Up
err_h:
Set noSession = Nothing
Set noDatabase = Nothing
Set noDocument = Nothing
Set noNextDocument = Nothing
Set noView = Nothing
End Sub
[/vba]
Reply With Quote