%REM
	Agent zExport-All-Attachment-Files
	Created Jan 1, 2013 by Tripp W Black/Mindwatering
	Description: Attachments Export Agent
%END REM
Option Public
Option Declare

Sub Initialize
	Dim s As New NotesSession
	Dim w As New NotesUIWorkspace
	Dim db As NotesDatabase						' current app
	Dim uiV As NotesUIView						' current view front-end
	Dim V As NotesView							' current view backend
	Dim vECol As NotesViewEntryCollection		' all entires in v
	Dim vE As NotesViewEntry					' view/doc entry in vECol
	Dim vDoc As NotesDocument					' vE's back-end document
	Dim vO As NotesEmbeddedObject				' embedded object in vDoc
	
	Dim promptme As Integer						' prompt to continue - yes/ok=6
	Dim fdefaultpath As String					' default save path from environment
	Dim fPrompt As Variant						' prompt variant for file path
	Dim fdir As String							' folder to save path selected/typed in
	Dim cfilecount As Integer					' count for files in a doc
	
	On Error GoTo SErrorHandler
	
	' set-up
	Set db = s.CurrentDatabase
	Set uiV = w.Currentview
	If (uiV Is Nothing) Then
		' give up
		Print "Cancelled export. No current view open."
		Exit Sub
	Else
		' get backend view
		Set v = uiV.View
	End If
	Set vECol = v.Allentries
	If (vECol.Count = 0) Then
		' no entries/docs to process
		Print "Cancelled export. No entries in view to export."
	End If
	promptme = MsgBox("You are about to extract all attachments from all documents in this view. " &_
	"You will be prompted where to save the documents. Would you like to continue.", 32 + 4, "Export Attachments")
	If Not (promptme = 6) Then
		Print "Cancelled export as requested."
		Exit Sub
	End If
	' update following line to preferred path
	fdefaultpath = "c:\temp\extract"
	' get the folder to export
	fPrompt = w.Savefiledialog(False, "Export Location?", "All files|*.*", fdefaultpath, "Choose and Save")
	If (IsEmpty(fPrompt) ) Then
		Print "Cancelled. No folder selected."
		Exit Sub
	End If
	fdir = StrLeftBack(CStr(fPrompt(0)), "Choose and Save", 5, 1 )
	If (fdir = "") Then
		' cancel
		Print "Error parsing folder location."
		Exit Sub
	End If
	Print "Export location: " & fdir & ". Starting export . . . "
	
	' loop through all entries and process attachments
	Set vE = vECol.Getfirstentry()
	While Not (vE Is Nothing)
		' get doc
		If (vE.Isdocument) Then
			Set vDoc = vE.Document
			cfilecount = 0
			If Not (vDoc Is Nothing) Then
				' check if has embedded objects / attachments
				If (vDoc.HasEmbedded) Then
					' see if embedded objects are attachments
					' do NOT use doc.EmbeddedObjects - it will blow up w/a type missmatch error
					ForAll i In vDoc.Items
						If (i.Type = 1084) Then
							' attachment type, continue
							ForAll ival In i.Values
								' get attachment
								Set vO = vDoc.GetAttachment(ival)
								If (vO.Type = 1454) Then
									' EMBED_ATTACHMENT (1454)
									' process attachment
									Call vO.ExtractFile( fdir & vDoc.Universalid & "_" & CStr(cfilecount) & "_" & vO.Name )
									
									' increment counter
									cfilecount = cfilecount + 1
								Else
									' object is not attachment
								End If
							End ForAll
						Else
							' not attachment item
						End If
					End ForAll
					
				End If
			End If
		End If
		
		' loop to next entry
		Set vE = vECol.Getnextentry(vE)
	Wend
	Print "Done."
	Exit Sub
SErrorHandler:
	Print "Error: " & CStr(Err) & " " & Error$ & ", line: " & CStr(Erl)
	Exit Sub
End Sub