Domino Code Fragment

Code Name*
File Import Agent		Date*
05/10/2002		Source (or email address if you prefer)*
[email protected]
IP address:.80.129.122.25
Description*
imports attachments at once		Type*
LotusScript		Categories*
File Input/Output
Implementation:
Modify code		Required Client:
(none)		Server:
5.0
Limitations:
Comments:
Files/Graphics attachments (if applicable): Code:
Sub Initialize

Dim session As New NotesSession
Dim Workspace As New NotesUIWorkspace
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem
Set db = session.CurrentDatabase

'Declarations
Dim DlgDoc As NotesDocument
Dim DlgReturn As Variant
Dim SelVal As String
Dim NameOfUser As NotesName
Dim pathName As String, fileName As String
Dim uidoc As NotesUIDocument
Dim view As NotesView

'Get User Input
Set DlgDoc=New NotesDocument(db)
Call DlgDoc.AppendItemValue("Form","DlgPicture")
DlgReturn=Workspace.DialogBox("DlgPicture",True,True,False,False,False,False,"Picture",DlgDoc)

'Check Dialog Return
If (DlgReturn) Then
SelVal = DlgDoc.Path(0)+"\\"
SelVal2 = DlgDoc.NewCats(0)
SelVal3 = DlgDoc.ImageCategory(0)
SelVal4 = DlgDoc.width(0)
SelVal5 = DlgDoc.height(0)
Else
Exit Sub
End If

directory$ = SelVal
pathName$ = directory$ + "*.*"
fileName$ = Dir$(pathName$, 0)

c = 0
Do While fileName$ <> ""
c = c +1
Set doc = New NotesDocument(db)
Set rtitem2 = doc.CreateRichTextItem("Picture")
Set notesEmbeddedObject = rtitem2.EmbedObject(EMBED_ATTACHMENT, "", directory$ + filename$, directory$ + filename$)

' check if category is selected if not use new category
If SelVal2 = "" Then
doc.ImageCategory=SelVal3
Else
doc.ImageCategory=SelVal2
End If
'set document fields
doc.Form="KIPhoto"
doc.ImageDate = Today()
doc.Title = filename$
doc.width = SelVal4
doc.height = SelVal5
doc.Title = filename$
doc.Filename = filename$
doc.DocAuthor = session.UserName
Call doc.Save(True,False)
Print fileName$
fileName$ = Dir$()
Loop
Print c + " images sucessfully uploaded"
Print c + " new documents created"
End Sub