Hallo zusammen,
ich benötige bei dem Lösen eine Aufgabe eure Unterstützung.
Wir haben eine Datenbank in der wir unsere eingescannten Rechnungen ablegen. Diese beinhaltet bis dato ca. 23.000 Dokument. Jedes dieser Dokumente besitzt n-Anhänge, die als JPG's in einem Richtextfeld abgespeichert werden.
Die konkrete Aufgabe lautet nun: Alle Dokumente mit Anhang und Daten exportieren (Migration auf DMS System).
Mittels folgendem Script, das ich im Internet gefunden habe, kann ich n-Anhänge in einem beliebigen Ordner speichern. Das funktioniert bestens.
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
'Messagebox i.Name
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
'**************************************************************
strTest = strTest & Chr(10) & Obj.Name
'**************************************************************
Call ExportAttachment(Obj)
'Call Obj.Remove
Call doc.Save( True, True ) 'creates conflict doc if conflict exists
End If
End Forall
Next
Set doc = dc.GetNextDocument(doc)
Wend
'**************************************************************
Msgbox strTest, 64, "Folgende Attachments wurden erkannt:"
'**************************************************************
' Msgbox "Export Complete.", 16, "Finished"
End Sub
Für den Export werden die Orginalnamen der Anhänge herangezogen. Dies ist, da die Namen den Syntax Scan-[Count].jpg besitzen weniger von Vorteil, denn [Count] wird pro Dokument neu definiert. Die Idee, beim Exportieren direkt den Dateinamen zu ändern, habe ich wieder verwerfen müssen, da dies - wie es meine Recherchen gezeigt haben - nicht möglich ist. Eine gangbare Alternative wäre die Datennamen grundsätzlich in einem ersten Step zu ändern, z.B. DokID-[Count].jpg und dann im zweiten Step die Daten zu exportieren.
Hierzu habe ich folgenden Code gefunden: http://atnotes.de/index.php/topic,44329.0.html (http://atnotes.de/index.php/topic,44329.0.html)
Allerdings muss ich gestehen, dass ich nicht wirklich verstehe was in dem Code passiert. Sehe ich das richtig, dass der Code nur einen Anhang umbennen kann?
Ich wäre euch sehr dankbar, wenn ihr mich bei meinem Problem, n-Anhänge aus einem Notesdokument umzubennen, unterstützen könntet.
ähem... Wo bitte ist die Funktion "ExportAttachment" definiert? Das ist (imho) kein Standard...
Das kann man doch ganz einfach mit obj.ExtractFile("D:\DeinPfad\DeinDateiName.jpg") machen, und dabei ist der Dateiname frei wählbar...
Gruss
Tode
Hallo zusammen,
manchmal sieht man vor lauter Wald die Bäume nicht mehr.
@Tode
Vielen Dank für deinen Hinweise. Ich habe das Script ein wenig umgebaut und siehe da es funktioniert :-) ... Und ein Textexport ist auch gleich mit dabei.
Den Part "ExportAttachment" hatte ich vergessen zu posten.
Hier nochmal mein Code - vielleicht hilft es dem einen oder anderen irgendwann mal.
Danke nochmal für eure Hilfe.
Sub Initialize
'****************************************************************************************************************
Dim s As NotesSession
Dim w As NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim rtItem As NotesRichTextItem
Dim RTNames List As String
Dim itemCount As Integer
Dim x As Integer
Dim j As Integer
Dim filenum As Integer
Dim exportPathAtt As String
Dim exportPathTxt As String
Dim exportName As String
Dim exportCount As Integer
Dim docCount As Integer
Dim docUIDText As String
Set s = New NotesSession
Set w = New NotesUIWorkspace
Set db = s.CurrentDatabase
Set dc = db.UnprocessedDocuments
Set doc = dc.GetFirstDocument
exportPathAtt = "C:\Temp\"
exportPathTxt = "C:\Temp\"
docCount = 1
filenum = Freefile()
'****************************************************************************************************************
x = Msgbox(Cstr(dc.Count) & " Dokumente ausgewählt. Fortsetzen?", 32 + 4, "Export")
If x <> 6 Then Exit Sub
While Not (doc Is Nothing)
'**********************************************************************************
itemCount = 0
exportCount = 0
docUIDText = doc.docIDText(0)
Erase RTNames
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
exportCount = exportCount +1
exportNameAtt = exportPathAtt + docUIDText + "_" + Cstr(exportCount) + ".jpg"
obj.ExtractFile(exportNameAtt)
End If
End Forall
Next
'******************************************************************************
exportNameTxt = exportPathTxt + docUIDText + ".txt"
Open exportNameTxt For Output As filenum
Print #filenum, "[Rechnungsnummer]:" + doc.reNr(0)
Close filenum
'******************************************************************************
Print "Export Dokument " + Cstr(docCount)
docCount = docCount + 1
Set doc = dc.GetNextDocument(doc)
Wend
Msgbox "Export Complete.", 16, "Finished"
End Sub