[gelöst] RTItem / Attachment umbennen

[two7]

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.

Code

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

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.

[Peter Klett]

Habs nur überflogen, aber da wird doch nur das RTItem umbenannt, oder?

Du willst doch die Dateinamen ändern. Da würde ich die Anhänge in ein temporäres Verzeichnis lösen, umbenennen und in das Zielverzeichnis verschieben.

[Tode]

ä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

[Peter Klett]

@Tode: Irgendwie war mir auch so, war aber zu faul, das nachzusehen und habe der Aussage blind vertraut. Sollte man nicht tun ...  

[two7]

ä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.

Code

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