asked on
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim nextdoc As NotesDocument
Dim dirpath As String
Dim view As NotesView
Dim fullpath As String
Set db = session.Currentdatabase
Set view = db.GetView("All Documents")
Set doc = view.Getfirstdocument
Dim num As Integer
dirpath = "D:\PlantEng"
If (Dir$ (dirpath, 16)="") Then
MkDir dirpath
End If
While Not doc Is Nothing
Set nextdoc = view.getnextdocument(doc)
'--Loop through all attachments in document and detach into D:\PlantEng
Dim rtitem As Variant
Set rtitem = doc.GetFirstItem("attachments")
'--Get the unique file number attached to the document
Dim FileNumber
Set FileNumber = doc.GetFirstItem("FileNumber")
'--Create a variable to cast a file number into a string
Dim FileNumberString As String
FileNumberString = CStr(FileNumber)
'--Create a variable to store the FileNumber as a folder
Dim fileNumberFolder As String
fileNumberFolder = dirpath + "\" + FileNumberString
'--Create a new folder based on the file number
MkDir fileNumberFolder
'--if array of embedded objects exist them detach all attachments into D:\PlantEng
If IsArray(rtitem.EmbeddedObjects) Then
ForAll o In rtitem.EmbeddedObjects
If(o.type = EMBED_ATTACHMENT) Then
If o.name <> o.source Then
fullpath = fileNumberFolder & "\" & o.source & +1
Else
fullpath = fileNumberFolder & "\"& o.source
End If
Call o.ExtractFile(fullpath)
End If
End ForAll
End If
Set doc = nextdoc
Wend
End Sub