A while ago I recall there was a tool (free utility from the old notes.net or something) that would scan any mail file or any database and export any attachments to a central store (like a C drive or network drive). I can’t find anything about this now but I recall something like this exists… any tips where to find it or how to accomplish this?
Subject: Bulk Attachment Export Tool?
you really need to change your user name!!
Subject: RE: Bulk Attachment Export Tool?
Why?
Subject: Bulk Attachment Export Tool?
why you do this not with an Agent ?Have a look in the designer help for “extractfile”.
there is a good and easy sample to do this by yourself.
regards bernhard
Subject: Bulk Attachment Export Tool?
Here’s something I wrote to export attachments that should get you started. I had to trim out some unrelated stuff and I didn’t test it, so be warned. This one pulls the attachments out of a specific RTF, but you could change it to get V2 attachments as well.
Sub ExportAttachmentsFiles
On Error Goto Errhandle
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Set db = session.CurrentDatabase
Set view = db.GetView("(Lookup Attachments)")
' Confirm authorization.
Dim isAdmin As Variant
isAdmin = Evaluate(|@IsMember("[Administration]"; @UserRoles) || @IsMember("[Authoring]"; @UserRoles)|)
If isAdmin(0) = False Then
Messagebox "You do not have sufficient access to use this Action.", MB_OK+MB_ICONSTOP, "Access Restriction"
Exit Sub
End If
' Get file path and name.
Dim attachmentPath As String
attachmentPath = workspace.Prompt (PROMPT_OKCANCELEDIT, "Export Attachments", "Please enter a path for the Attachments files.", "C:\Attachments\", "")
If attachmentPath = "" Then
errorString = "You must enter an existing folder's path for the Attachments files." & Chr(10) &_
"Export Attachments agent stopped."
Messagebox errorString, 0+16, "Export Attachments Agent Error"
Exit Sub
End If
' Create folders if necessary.
tempPath = attachmentPath
If Not MakeDirectories(tempPath) Then
errorString = "There was an error creating folders for the Attachments files." & Chr(10) &_
"Export Attachments agent stopped."
Messagebox errorString, MB_OK+MB_ICONSTOP, "Export Attachments Agent Error"
Exit Sub
End If
Print "Opening " & filePath & "..."
Dim fileNum As Integer
fileNum = Freefile()
Open filePath For Output As fileNum
' Set up document processing.
Dim successCounter As Integer
Dim failCounter As Integer
Dim entryCount As Integer
successCounter = 0
failCounter = 0
entryCount = view.EntryCount
Dim answer As Integer
Print "Starting export..."
Dim rtitem As Variant
Dim item As NotesItem
Print "Starting export..."
Set doc = view.GetFirstDocument
While Not doc Is Nothing
If Not (doc.Form(0)="Attachments Doc") Then Goto NextDoc
Print "Analyzing: " & doc.Number(0)
Set rtitem = doc.GetFirstItem("Attachments")
If Not(rtitem Is Nothing) Then
If (rtitem.Type = RICHTEXT) Then
If Not(Isempty(rtitem.EmbeddedObjects)) Then
Forall obj In rtitem.EmbeddedObjects
If (obj.Type = EMBED_ATTACHMENT) Then
Dim attachmentName As String
attachmentName = GetUniquefileName(attachmentPath, obj.Source)
Call obj.ExtractFile(attachmentPath & attachmentName)
End If
End Forall
End If
End If
End If
NextDoc:
successCounter = successCounter + 1
Set doc = view.GetNextDocument(doc)
Wend
Goto Done
Errhandle:
failCounter = failCounter + 1
answer = Messagebox ("Error" & Str(Err) & ": " & Error$ & Chr(13) & Chr(13) & "Try to continue?", MB_YESNO+MB_ICONEXCLAMATION+MB_DEFBUTTON2, "Document Processing")
If answer = IDNO Then
Resume Done
End If
Resume Next
Done:
Messagebox "Processed " & Cstr(successCounter) & " item(s) successfully." & Chr(13) & Cstr(failCounter) & " Item(s) failed.", MB_OK+MB_ICONINFORMATION, "Document Processing"
Print ""
End Sub
Subject: RE: Bulk Attachment Export Tool?
I noticed that it calls this utility.
Function GetUniqueFileName (filePath As String, fileName As String) As String
Dim splitName As String
Dim extName As String
Dim fileExists As String
Dim fileNum As Integer
Dim uniqueName As String
fileNum = 0
uniqueName = fileName
CheckName:
fileExists = Dir$(filePath$ & uniqueName, 0)
If Len(fileExists) = 0 Then
Goto ExitFunction
Else
fileNum = fileNum + 1
extName = Strrightback(fileName, ".", 2)
splitName = Strleft(fileName, "." & extName, 2)
uniqueName = splitName & " (" & Cstr(fileNum) & ")." & extName
Goto CheckName
End If
ExitFunction:
GetUniqueFileName = uniqueName
End Function
Function MakeDirectories (filePath As String) As Boolean
’ This function overcomes limitations of the LotusScript Mkdir statement by being able to create multiple folders in a hierarchical structure just like the MS-DOS mkdir command.
’ WARNING: This sub has only been tested in a Windows environment, but is expected to work in Linux/UNIX. It does not support any version of Mac OS. FYI, Mac OS X and later are based on UNIX and use a forward slash “/” separator. Mac OS 9 and earlier use a colon “:” separator.
Dim startingDrive$, startingDir$, drive$, currentDir$, OSDirectorySeparator$
MakeDirectories = False
On Error Goto Failure ' For all other errors (besides Error 75 below), handle them.
On Error 75 Resume Next ' Ignore errors associated with creating folders that already exist.
' Set character used by the operating system to separate folders.
If isDefined("WINDOWS") Then
OSDirectorySeparator = "\" ' DOS/Windows uses a backslash.
Else
OSDirectorySeparator = "/" ' Linux and UNIX use a forward slash.
End If
startingDrive = Curdrive
startingDir = Curdir
' If filePath does not end with the separator character, concatenate it. We need it for our string manipulations.
If Right(filePath, 1) <> OSDirectorySeparator Then
filePath = filePath & OSDirectorySeparator
End If
' If this is a Windows environment and filePath begins with a drive letter/colon, x: ...
If isDefined("WINDOWS") And Instr(1, filePath, ":") = 2 Then
drive = Left(filePath, 2) ' Extract drive letter and colon.
Chdrive drive ' Switch to that drive.
filePath = Strright(filePath, drive) ' Strip drive from filePath now that we've handled it.
End If
' If filePath now begins with "\" (Windows) or "/" (Linux, UNIX) ...
If Instr(1, filePath, OSDirectorySeparator) = 1 Then
Chdir OSDirectorySeparator ' Switch to this root folder.
filePath = Strright(filePath, OSDirectorySeparator) ' Strip leading separator now that we're done with it.
End If
Do
currentDir = Strleft(filePath, OSDirectorySeparator)
Mkdir currentDir
Chdir currentDir
filePath = Strright(filePath, OSDirectorySeparator) ' Grab everything to the right of the current directory we've just processed.
If filePath = "" Then ' If we've run out of directories to create, exit.
Exit Do
End If
Loop
Chdrive startingDrive ' Return user to original drive and directory.
Chdir startingDir
makeDirectories = True
Exit Function
Failure:
MakeDirectories = False
Resume Finished
Finished:
End Function