'Export MS Office Library: Option Public Option Explicit Sub Initialize '** This agent will take all the selected documents in a database that uses '** the basic Microsoft Office Document Library template and send them to '** another database (in my case, I just used one based on the Doc Library '** template). The issue is that MS Office docs in an Office Document Library '** are stored as OLE embedded files, so they're hard to move from one doc '** to another. This agent uses OLE to open the embedded files with their '** default applications and save them to the file system, and then attach the '** saved file to a new document in the new database. If there is no embedded '** file, the entire rich-text Body field is copied over intact. '** '** Obviously, this will only work if the computer you're running this agent on '** has MS Office installed. I have the code set up to run against "Selected '** Documents" in a view, although you can easily change it to run against '** all the docs in the database or some subset thereof. '** '** version 1.0 -- initial release '** version 1.1 -- added an OLE command to keep Excel spreadsheets visible (for '** some reason, they were getting saved as hidden documents otherwise) '** '** Julian Robichaux -- http://www.nsftools.com On Error Goto processError '** variables relating to this database (this database should be the MS Office Library) Dim session As New NotesSession Dim db As NotesDatabase Dim dc As NotesDocumentCollection Dim doc As NotesDocument Dim rtitem As NotesRichTextItem Dim oleObj As Variant Set db = session.CurrentDatabase Set dc = db.UnprocessedDocuments Set doc = dc.GetFirstDocument '** variables relating to the database we're exporting to Dim exportDbName As String Dim exportDb As NotesDatabase Dim newDoc As NotesDocument Dim body As NotesRichTextItem Dim tempDir As String Dim fileCount As Integer Dim fileName As String Dim fname As String '** MODIFY THESE TWO STRINGS FOR YOUR OWN USE exportDbName = "JPR\Doc Lib Test.nsf" tempDir = "C:\windows\temp\" '** try to open the database we're exporting to Set exportDb = session.GetDatabase("", exportDbName, False) If (exportDb Is Nothing) Then Print "Cannot open export database: " & exportDbName Exit Sub End If '** try to export all the selected docs Do Until (doc Is Nothing) Set newDoc = New NotesDocument(exportDb) newDoc.Form = "Document" newDoc.Categories = doc.Categories newDoc.WebCategories = doc.Categories newDoc.Subject = doc.Subject(0) & " (created " & Datevalue(doc.Created) & ")" Set rtitem = doc.GetFirstItem("Body") Set body = New NotesRichTextItem(newDoc, "Body") fileCount = 0 fileName = "" If Not (rtitem Is Nothing) Then If Not (Isempty(rtitem.EmbeddedObjects)) Then Forall o In rtitem.EmbeddedObjects If (o.Type = EMBED_OBJECT) Then '** if we have an embedded object in the rich text field, '** we'll try to save it as a file and attach it to our new doc fileCount = fileCount + 1 fileName = tempDir & "detachedOleFile" & fileCount '** for MS Office documents, this normally works (of course, '** you need to make sure that a proper version of Office is '** installed on the computer you're doing this on), although '** you'll often get an error or two as you call these methods, '** due to variations in the different Office object models Set oleObj = o.Activate(False) '** this is so Excel spreadsheets don't end up being hidden oleObj.Application.Windows(oleObj.Application.Windows.Count).Visible = True Call oleObj.SaveAs(fileName) Call oleObj.Close '** try two different ways to shut down the background application Call oleObj.Quit Call oleObj.Application.Quit Set oleObj = Nothing '** usually, MS Office will automatically append a file extension '** to the end of the file name, so we'll have to use Dir to make '** sure we get the file we just detached fname = Dir$(fileName & "*", 0) If (fname = "") Then fileCount = fileCount - 1 Else fName = tempDir & fName Call body.EmbedObject(EMBED_ATTACHMENT, "", fName) Kill fname End If End If End Forall End If '** in this example, if we found any embedded OLE objects, we're not '** going to bother with copying over anything else in the Body field, and '** if we didn't find any embedded objects, we'll copy the whole rich text '** item intact. You could also set this up to copy the Body item over '** regardless, although if you did that you'd want to do it before you started '** checking for OLE objects If (fileCount < 1) Then Call newDoc.CopyItem(rtitem, "Body") End If End If '** ComputeWithForm sometimes messes up the Categories field for some reason... Call newDoc.ComputeWithForm(True, False) Call newDoc.Save(True, True) Set newDoc = Nothing Set doc = dc.GetNextDocument(doc) Loop Print "Finished exporting " & dc.Count & " docs" Exit Sub processError: '** more than likely, our errors will have to do with OLE issues, '** so we're going to be daring and Resume Next when we '** see any problems (this process is actually quite error-prone, '** due to differences in all the versions of all the MS Office OLE '** function libraries) Dim errMsg As String errMsg = "Error " & Err & ": " & Error$ Print errMsg If Not (newDoc Is Nothing) Then newDoc.ImportErrMsg = newDoc.ImportErrMsg(0) & errMsg & Chr(13) & Chr(10) End If Resume Next End Sub
This LotusScript was converted to HTML using the ls2html routine,
provided by Julian Robichaux at nsftools.com.