save all attachments from all emails in a Lotus Notes folder

save_attachments.vb

Sub Click(Source As Button)
  Dim dialog As New NotesUIWorkspace
	Dim Maildb As NotesDatabase
	Dim Session As New NotesSession
	Dim view As NotesView
	
	Set Maildb = Session.CurrentDatabase
	
'	ATTENTION: enter the folder name here
	folderName = "testfolder"
	path = ""
	
	Set view = Maildb.GetView(folderName)	
	
	With view
		Set doc = .GetFirstDocument
		Set Item = doc.GetFirstItem("Body")
'		get folder name from user
		path = Inputbox("Enter the path to save attachments", "Path?", DEFAULT)
'		default path would be C:\<foldername>
		If path = "" Then
			path = "C:\" + folderName
		End If
		DirExists = (Dir$ (path,16 ) <> "" )
		If DirExists = False Then
			Mkdir path
		End If
		
		While Not (doc Is Nothing)
			Forall i In doc.Items
				If i.type = Attachment Then
					Set emb = doc.GetAttachment(i.values(0))
					filename = emb.source
					Set notesEmbeddedObject = doc.GetAttachment(filename)
					notesEmbeddedObject.ExtractFile(path + "\" + filename)
				End If
			End Forall
			Set doc = .GetNextDocument(doc)
		Wend
	End With
	
	Messagebox("Done, check " + path)
End Sub