0

やるべき課題があります - それは、ドキュメントとその添付ファイルを含む Lotus Notes DB からデータを抽出することです。これの目的は、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

なぜそれが失敗を引き起こし、プロセス全体を停止するのか誰にもわかりますか?

ありがとう、ラファル

4

2 に答える 2