Subject: Importing Word Documents in Notes
This is something I have been using for a while. Probably not optimized, but I coded it in English and commented it pretty well to make it easier for other team members to maintain and customize.
It prompts the user for a directory to load files from, then it prompts the user for a directory to move files to after load. (In case something happens during the run, all the files that were successfully processed are not mixed in with the files still to be done.)
It loops through the import folder, attaches the file to a new doc, sets the fields on the doc, sets the security, etc. After the file upload it moves the file to the done folder. Every action is logged to an agent log (mine is called logagent.nsf from the standard agent log template) and keeps track so you can see if there were any errors.
I had to strip out client specific stuff here, so if there are variables that are declared that are not being used, that is why. Run it through the debugger a couple of times to work out the kinks specific to your org, but the basics are here.
Good luck!
Sub Initialize
On Error Goto Oops
Print "Starting import"
'declare variables
'general
Dim s As New notessession
Dim ws As New notesuiworkspace
Dim db As notesdatabase
'Notes docs
Dim doc As notesdocument
Dim rtItem As notesrichTextitem
Dim fileAttachment As NotesEmbeddedObject
'to set security on new docs
Dim aItem As notesitem
Dim rItem As notesitem
'
Dim authorChoices(0 To 1) As String
authorChoices(0)="[Administrator]"
authorChoices(1)="[Developer]"
'
Dim readerChoices(0) As String
readerChoices(0)=""
'for logging
Dim LSLog As New NotesLog( "Import" )
Dim Message As String
'misc variables
Dim numCurrent As Long
Dim numUploaded As Long
Dim currentErrorFound As Boolean
Dim errorFound As Boolean
Dim haveLog As Boolean
Dim inLoop As Boolean
Dim startedLoop As Boolean
Dim finishPrompt As Boolean
Dim isFileOpened As Boolean
Dim movingFile As Boolean
Dim moveFileName As String
Dim fileNameString As String
'file variables
Dim ImportFolder As String
Dim DoneFolder As String
Dim currentDoc As String
'**************************************************
'SET VARIABLES THAT ARE KNOWN
Set db=s.currentdatabase
'initialize variables
numCurrent = 0
numUploaded = 0
currentErrorFound=False
errorFound = False
finishPrompt=True
'**************************************************
'GET THE PATH FOR THE FILES
Dim gArray As Variant
Dim gdArray As Variant
gArray=ws.SaveFileDialog( True , "Upload Files From Directory", ,"C:\", "" )
If Isempty(gArray) Then
Messagebox "The import is not configured. Import terminated.", 0, "Error"
finishPrompt=False
Goto Done
End If
If Isempty(gArray) Then
Messagebox "The import is not configured. Import terminated.", 0, "Error"
finishPrompt=False
Goto Done
End If
ImportFolder=gArray(0)+"\"
gdArray=ws.SaveFileDialog( True , "Save Done Files To Directory", ,"", ImportFolder )
If Isempty(gdArray) Then
Messagebox "The import is not configured. Import terminated.", 0, "Error"
finishPrompt=False
Goto Done
End If
DoneFolder=gdArray(0)+"\"
'----
'**************************************************
'LOG START
Call LSLog.OpenNotesLog( db.server, "LogAgents.nsf")
haveLog=True
Message="Starting import"
Call LSLog.LogAction(Message)
Call LSLog.LogAction("Importing from: "+ImportFolder)
Call LSLog.LogAction("Saving to: "+DoneFolder)
'**************************************************
'RETRIEVE FILES AND LOOP THROUGH
'retrieve the first file
’ currentDoc = Dir(ImportFolder+“.”, 0)
currentDoc = Dir(ImportFolder)
Print "Importing files. Please wait..."
'loop through the quotes
Do Until currentDoc=""
'used in error routine to determine return point
inLoop=True
startedLoop=True
isFileOpened=False
movingFile=False
'increment the current number
numCurrent= numCurrent + 1
'reset error handling
currentErrorFound = False
'create document
Set doc=db.createDocument
'attach the file
Set rtItem=doc.getfirstitem("fileattachment")
If rtItem Is Nothing Then Set rtItem=doc.createrichtextitem("fileattachment")
Set fileAttachment = rtitem.EmbedObject(EMBED_ATTACHMENT, "", ImportFolder+currentDoc)
'save the doc
numUploaded=numUploaded+1
doc.form="FORM NAME HERE"
'set other doc fields here
'...
doc.EntryAuthor=s.commonUserName
doc.EntryCreationDate=Now()
fileNameString=Trim(Strleftback(fileAttachment.name, "."))
doc.Title=fileNameString
doc.AuthorChoices=authorChoices
doc.ReaderChoices=readerChoices
Set aItem=doc.getFirstItem("AuthorChoices")
If Not aItem Is Nothing Then
aItem.isAuthors=True
End If
Set rItem=doc.getFirstItem("ReaderChoices")
If Not rItem Is Nothing Then
rItem.isReaders=True
End If
Call doc.save(True, True)
'End Document
'************************
NextDoc:
'copy prepare to move the file to the DONE directory
If Not currentErrorFound Then
moveFileName=currentDoc
End If
'move onto the next file
currentDoc= Dir$
If Not currentErrorFound Then
'move the finished file
movingFile=True
Filecopy ImportFolder+moveFileName, DoneFolder+moveFileName
Kill ImportFolder+moveFileName
DoneMovingFile:
movingFile=False
End If
currentErrorFound=False
Loop
inLoop=False
Done:
'log end
If haveLog Then Call LSLog.LogAction("Ending import")
Print "File processing complete."
'prompt
If numCurrent<>1 And numUploaded<>1 Then
Message=Cstr(numCurrent)+" files processed."+Chr(10)+Cstr(numUploaded)+" files uploaded."+Chr(10)+Chr(10)
Elseif numCurrent=1 And numUploaded=1 Then
Message=Cstr(numCurrent)+" file processed."+Chr(10)+Cstr(numUploaded)+" file uploaded."+Chr(10)+Chr(10)
Elseif numCurrent<>1 Then
Message=Cstr(numCurrent)+" files processed."+Chr(10)+Cstr(numUploaded)+" file uploaded."+Chr(10)+Chr(10)
Else
Message=Cstr(numCurrent)+" file processed."+Chr(10)+Cstr(numUploaded)+" files uploaded."+Chr(10)+Chr(10)
End If
If errorFound And finishPrompt Then
Message=Message+" At least one error was recorded in the log."
Messagebox Message, 0, "Process Complete"
Else
Message=Message+" Imported completed successfully."
If finishPrompt Then Messagebox Message, 0, "Process Complete"
End If
Print "Ending import."
If haveLog Then Call LSLog.Close
Exit Sub
Oops:
Dim errorNum As String
Dim errorLine As String
Dim agentStatus$
errorFound=True
currentErrorFound=True
If haveLog Then
ErrorNum=Cstr(Err())
ErrorLine=Cstr(Erl())
Message=s.currentagent.name+"-agent run on "+Cstr(Now)
agentStatus$ = "Error " & ErrorNum & " at line " & ErrorLine & ": " & Error()
Call LSLog.LogError(Err(), Message+" "+agentStatus$)
End If
If inLoop Then
'if errored out when moving the file then end moving file
If movingFile Then
Goto DoneMovingFile
'else, goto next doc
Else
Goto NextDoc
End If
'if not in loop
Else
Resume Next
End If
End Sub