Dim sDir As String
Dim ses As NotesSession
Dim work As NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Sub Initialize
Set ses = New NotesSession
Set work = New NotesUIWorkspace
Set db = ses.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
While Not (doc Is Nothing)
iCount = 0
itemCount = 0
lngExportedCount = 0
Erase RTNames
Erase DocNames
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 )
End If
End ForAll
Next
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 )
Next
Set doc = dc.GetNextDocument(doc)
Wend
MsgBox "Export Complete.", 16, "Finished"
End Sub
Sub ExportAttachment(o As Variant)
Dim ses As New NotesSession
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim varDate As Variant
Dim strYear As String
Dim strMonth As String
Dim strFolderName As String
Set db = ses.CurrentDatabase
Set dc = db.AllDocuments
Set doc = dc.GetFirstDocument()
While Not doc Is Nothing
varDate = doc.GetItemValue( "Date" )(0)
strYear = CStr( Year( varDate ) )
strMonth = CStr( Month( varDate ) )
strFolderName = strYear & "\" & strMonth
Call doc.PutInFolder( strFolderName )
Set doc = dc.GetNextDocument( doc )
Wend
Print "Exporting " & strFolderName
Call o.ExtractFile( strFolderName )
End Sub
Hallo Leute,
ich bekomme eine Fehlermeldung Type Misstach.
Ich habe eine Datenbank mit ca. 5000 Dokumenten. Ein Dokument beinhaltet Information wie z.B. Name, Datum, Betrag, Kommentar und ein Body-Feld (meistens .pdf).
Ich möchte ich die Anhänge.pdf (Body-Feld) in Windows-Explorer exportieren. Das klappt auch. Nun möchte ich aber, dass es
bisschen sortierter wird, Ordner erstellen lassen mit den Datumswerten und dann in den Ordner die passenden Anhänge.
Vielen Dank im Voraus
MFG
Max