Lotus Notes代理 - 从数据库中提取附件以分隔每个文档的文件夹

Question

要完成任务 - 从Lotus Notes数据库中提取数据，包括文档及其附件。这样做的目的是将它作为库存放在Sharepoint上。

到目前为止，我已设法创建一个视图并导出数据，以便在Excel中进行结构化。

此外，我还查找了一些用于提取附件的代理示例。通过以下脚本的实现，我设法导出了附件：

Dim sDir As String
Dim s As NotesSession
Dim w As NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument

Sub Initialize

 Set s = New NotesSession
 Set w = New NotesUIWorkspace 
 Set db = s.CurrentDatabase
 Set dc = db.UnprocessedDocuments
 Set doc = dc.GetFirstDocument
 Dim rtItem As NotesRichTextItem
 Dim RTNames List As String
 Dim DOCNames List As String
 Dim itemCount As Integer
 Dim sDefaultFolder As String
 Dim x As Integer
 Dim vtDir As Variant
 Dim iCount As Integer
 Dim j As Integer
 Dim lngExportedCount As Long
 Dim attachmentObject As Variant


 x = MsgBox("This action will extract all attachments From the " & CStr(dc.Count) & _
 " document(s) you have selected, And place them into the folder of your choice." & _
 Chr(10) & Chr(10) & "Would you like To continue?", 32 + 4, "Export Attachments")
 If x <> 6 Then Exit Sub 

 sDefaultFolder = s.GetEnvironmentString("LPP_ExportAttachments_DefaultFolder")
 If sDefaultFolder = "" Then sDefaultFolder = "F:"
 vtDir = w.SaveFileDialog( False, "Export attachments To which folder?", "All   files|*.*", sDefaultFolder, "Choose Folder and Click Save")
 If IsEmpty(vtDir) Then Exit Sub
 sDir = StrLeftBack(vtDir(0), "\")
 Call s.SetEnvironmentVar("LPP_ExportAttachments_DefaultFolder", sDir) 

 While Not (doc Is Nothing)

  iCount = 0
  itemCount = 0
  lngExportedCount = 0
  Erase RTNames
  Erase DocNames

  'Scan all items in document
  ForAll i In doc.Items

   If i.Type = RICHTEXT Then
    Set rtItem = doc.GetfirstItem(i.Name)
    If Not IsEmpty(rtItem.EmbeddedObjects) Then
 RTNames(itemCount) = CStr(i.Name)
 itemCount = itemCount +1
    End If
   End If

  End ForAll  

  For j = 0 To itemCount-1 
   Set rtItem = Nothing
   Set rtItem = doc.GetfirstItem(RTNames(j))
   ForAll Obj In rtItem.EmbeddedObjects
    If ( Obj.Type = EMBED_ATTACHMENT ) Then
     Call ExportAttachment(Obj)
     Call doc.Save( False, True ) 
 'creates conflict doc if conflict exists
    End If 
   End ForAll 
  Next

  'Scan all items in document
  ForAll i In doc.Items

   If i.Type = ATTACHMENT Then

    DOCNames(lngExportedCount) = i.Values(0)
    lngExportedCount = lngExportedCount + 1

   End If

  End ForAll

  For j% = 0 To lngExportedCount-1 
   Set attachmentObject = Nothing
   Set attachmentObject = doc.GetAttachment(DOCNames(j%))
   Call ExportAttachment(attachmentObject)     
   Call doc.Save( False, True ) 
'creates conflict doc if conflict exists
  Next  

  Set doc = dc.GetNextDocument(doc)
 Wend

 MsgBox "Export Complete.", 16, "Finished"

End Sub

Sub ExportAttachment(o As Variant)

Dim sAttachmentName As String
Dim sNum As String
Dim sTemp As String

sAttachmentName = sDir & "\" & o.Source
While Not (Dir$(sAttachmentName, 0) = "")
    sNum = Right(StrLeftBack(sAttachmentName, "."), 2)
    If IsNumeric(sNum) Then
        sTemp = StrLeftBack(sAttachmentName, ".")
        sTemp = Left(sTemp, Len(sTemp) - 2)
        sAttachmentName = sTemp & Format$(CInt(sNum) + 1, "##00") & _
        "." & StrRightBack(sAttachmentName, ".")
    Else
        sAttachmentName = StrLeftBack(sAttachmentName, ".") & _
        "01." & StrRightBack(sAttachmentName, ".")
    End If
Wend

Print "Exporting " & sAttachmentName
'Save the file
Call o.ExtractFile( sAttachmentName ) 

    End Sub

所以我现在遇到的问题是这些附件被保存到同一个文件夹，这意味着我会手动将它们放入库的右侧文件夹（几千个）。任何人都可以帮助我如何更改上面的代码，以便将附件保存到DB中每个文档的单独文件夹中？

由于某种原因，我无法找到下面的行导致错误弹出“对象变量未设置”：

sAttachmentName = sDir & "\" & o.Source

有人知道为什么会导致失败并停止整个过程吗？

谢谢， 拉法尔

Answer 1

您需要使用MkDir语句在文件夹中创建目录和提取附件。可能会写一些类似的东西：

MkDir sDir

Answer 2

您需要编写为每个文档创建新目录的代码（确保检查目录是否存在，并且最好确保每个目录都有唯一的名称）。

我写了一个这样的工具，它将文档的所有字段导出为XML，以及附件和嵌入图像。它可以设置为将每个文档分成它自己的目录。 您可以在下面的链接中阅读更多相关内容，也许您可​​以从描述中获得一些想法。我使用文档的UniversalID来获取唯一的文件夹名称。

http://www.texasswede.com/websites/texasswede.nsf/Page/Notes%20XML%20Exporter