Autor Thema: Attachment exportieren (Gelesen 3803 mal)

cheech · « **am:** 26.08.05 - 20:48:03 »

Hallo Notesspezialisten !

Ich habe ein Problem beim exportieren von Attachments aus einer Ansicht. der Agent funktioniert im Mailtemplate hervoragend aber in einer DB dann nicht mehr. Ich finde im Script keine Hinweise das es nur aufs Mailtemplate angepaßt wurde.

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
					Call ExportAttachment(Obj)
					Call Obj.Remove
					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 attachmentObject.Remove   
			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

Danke für eure Hilfe
Cheech

Axel · « **Antwort #1 am:** 26.08.05 - 21:27:10 »

Hi,

erstmal herzlich willkommen im Forum.

Was funktioniert denn nicht. Was sagt der Debugger zu dem Thema.
Ein paar mehr Infos wären nicht schlecht.

Axel

cheech · « **Antwort #2 am:** 26.08.05 - 22:02:30 »

Hallo Alex,

vielen Dank für die rasche Antwort.

Der Agent speichert das Attachment nicht in den definierten Ordner, in der MailDB aber schon. Der Debugger meldet keine Fehler, alles rennt ordnungsgemäß ab.

Irgendwie überspringt er bei

Code

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 Obj.Remove
					Call doc.Save( False, True )  'creates conflict doc if conflict exists
				End If 
			End Forall 
		Next

Ich sehe nur beim Debugger das er dort nicht zum Call ExportAttachment kommt.

Danke
Cheech

TMC · « **Antwort #3 am:** 26.08.05 - 23:25:53 »

Hab mal Deinen Code spaßeshalber in einen Agenten kopiert.

Lässt sich nicht speichern. Du solltest erstmal Option Declare einschalten.

Dann verweist Du auf die Function "ExportAttachment", die ist aber in Deinem Posting nicht vorhanden. Ich hab die jetzt mal auskommentiert und den restlichen Code entfernt.
Außerdem die nötigen Dims reingesetzt.

Bei mir klappt das ohne Probleme in einer App, er springt in die "If ( Obj.Type = EMBED_ATTACHMENT ) Then"...
Msgbox enthält bei mir alle Attachmentnamen, die auch erscheinen sollten...

Poste doch mal den ganzen Code...

Dann solltest Du den SaveFileDialog anpassen, nämlich den 1. Parameter auf TRUE stellen, es soll doch nur ein Verzeichnis ausgewählt werden, und keine Datei....

Code

Sub Initialize
	
	Dim s As New NotesSession
	Dim w As New NotesUIWorkspace	
	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
	Dim sDir  As String
	Dim doc As NotesDocument	
	Dim dc As NotesDocumentCollection	
	Dim db As NotesDatabase	
	Dim strTest As String
	Set db = s.CurrentDatabase
	Set dc = db.UnprocessedDocuments
	Set doc = dc.GetFirstDocument	
	
	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( False, 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

cheech · « **Antwort #4 am:** 26.08.05 - 23:41:59 »

Hallo Mathias !

Ich habe jetzt deine Code versucht, leider bekomme ich nicht die MsgBox mit der Meldung obwohl ein Attachment im Dokument ist.

Der Debugger läuft ohne Probleme durch ?

Gibt es mehrere Arten von RT Feldern oder wie man die Attachments im Dokument speicher kann ?

Danke
Cheech

cheech · « **Antwort #5 am:** 26.08.05 - 23:44:11 »

Hallo Matthias,

anbei der Code

Declaration

Code

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

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
					Call ExportAttachment(Obj)
					Call Obj.Remove
					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 attachmentObject.Remove   
			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

Code

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

Danke
Cheech

TMC · « **Antwort #6 am:** 26.08.05 - 23:50:30 »

Schlage vor, wir bleiben mal bei meinem Code, damit wir vom gleichen sprechen, und da dort erstmal nix verändert wird in der Notes-DB....

Zitat von: cheech am 26.08.05 - 23:41:59

Der Debugger läuft ohne Probleme durch ?

Den hab ich erst gar nicht eingeschaltet

Bei mir kommt die Msgbox mit den Attachments, d.h. es gibt dann auch keine Probleme im Script...

Zitat von: cheech am 26.08.05 - 23:41:59

Gibt es mehrere Arten von RT Feldern oder wie man die Attachments im Dokument speicher kann ?

Es gibt Richtext und RichtextLite. Wobei der Code auch bei RTLite gehen sollte.
Wie hast Du die Attachments denn drin, als Anhang (Menü: File/attach)? Denn nur so sollte es klappen, damit die Prüfung auf EMBED_ATTACHMENT auch WAHR (TRUE) ist.

Welche Einstellungen hast Du im Agenten? Als Target sollte "All selected docs" stehen.

tomtomtom · « **Antwort #7 am:** 26.08.05 - 23:51:53 »

Die Msgbox ist auskommentiert, oder etwa nicht $:-\$

TMC · « **Antwort #8 am:** 26.08.05 - 23:52:52 »

Zitat von: tomtomtom am 26.08.05 - 23:51:53

Die Msgbox ist auskommentiert, oder etwa nicht $:-\$

Nein:

Code

Msgbox strTest, 64, "Folgende Attachments wurden erkannt:"

Eine andere ja, aber die tut jetzt wenig zur Sache, zeigt ja nur Item-Namen an

cheech · « **Antwort #9 am:** 27.08.05 - 00:03:53 »

Ich habe jetzt deine Code ausprobiert.
Es erscheint die Messagebox aber mit keinem Inhalt.

Ich werde den Anhang in dem Dokument neu erstellen über File/Anhängen in das Doc hinzufügen und dann noch einmal probieren.

Einen Moment....

TMC · « **Antwort #10 am:** 27.08.05 - 00:10:04 »

Sehr wichtig ist auch, welche Agenten-Einstellungen Du hast.

Hier kommt noch eine Msgbox, die Dir die Anzahl der erkannten Docs anzeigt:

Außerdem ein ErrorHandler.

Code

Sub Initialize
	
	On Error Goto ErrorHandler
	
	Dim s As New NotesSession
	Dim w As New NotesUIWorkspace	
	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
	Dim sDir  As String
	Dim doc As NotesDocument	
	Dim dc As NotesDocumentCollection	
	Dim db As NotesDatabase	
	Dim strTest As String
	Set db = s.CurrentDatabase
	
	
	Set dc = db.UnprocessedDocuments
	
	'**********************************************
	Msgbox "Es wurden >" & dc.Count & "< Dokumente ausgewählt.", 64, "Info"
	'**********************************************	
	Set doc = dc.GetFirstDocument	
	
	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( False, 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"
	
GoOut:
	Exit Sub
ErrorHandler:
	Msgbox "Fehler #" & Err & " — " & Error$ & " (Zeile: " & Erl & ")", 48, "Laufzeitfehler"
	Resume GoOut
End Sub

cheech · « **Antwort #11 am:** 27.08.05 - 00:11:07 »

Es hat funktioniert....

In der Messagebix word das Attachment angezeigt.

Also sind die Attachments falsch im Dokument hinzugefügt worden ?
oder gibt es eine andere Möglichkeit diese auszulesen ?

Cheech

TMC · « **Antwort #12 am:** 27.08.05 - 00:14:34 »

Na ja, "falsch" ist relativ, eigentlich gibt es "falsch" nicht

Wie wurden die denn hinzugefügt?

Gibt's da ein Icon, welches man doppelklicken kann, und dann eine Box erscheint, in der man diese auf die Festplatte speichern kann? Screenshot wäre vielleicht ganz gut.

Kann auch sein, dass die Dokumente "zerstört" sind. Aber da brauchen wir weitere Infos (Screenshot etc)

cheech · « **Antwort #13 am:** 27.08.05 - 00:19:57 »

Leider weiß ich nicht wie die Attachments hinzugefügt worden sind, ich habe die Aufgabe bekommen diese aus der DB in einen Ordner zu exportieren.

Anbei ein Screenshot

TMC · « **Antwort #14 am:** 27.08.05 - 00:26:30 »

alles klar, embedded Object

Die User haben das als Objekt eingebunden, sehr unpraktisch

Spontan würde ich sagen: schwierig, AFAIK mit den aktuellen Klassen nicht möglich, die Teile auf die Festplatte zu bekommen, da die ExtractFile-Methode nur bei echten Attachments greift.

Schau mir das jetzt mal kurz mit DXL an, Moment......

TMC · « **Antwort #15 am:** 27.08.05 - 00:36:55 »

Habe das auch schon erlebt, ich glaube wenn man Dateien per Drag & Drop in Notes zieht, dann erstellt Notes embedded Objects und nicht Attachments

Als Schnellschuß würde ich sagen: mit LotusScript-Klassen kommst Du daran nur über DXL. Ist ein komplexes Thema, und nicht mal schnell in einem Posting kurz erklärbar. DXL sieht so aus als dass man da gut drankommt.

Alternativ evtl. NotesAPI, ist aber noch komplexer.

Unter'm Strich wahrscheinlich besser: Schau Dir mal Normunds RTLib http://www.rtlib.com/ an, kann gut sein dass die das kann. Falls nicht, wäre Ben Langhinrichs eine 2. Anlaufstelle: http://www.geniisoft.com/. Beide sind DIE Profis in Sachen Notes RTF.

koehlerbv · « **Antwort #16 am:** 27.08.05 - 01:12:04 »

Matthias, Drag 'n Drop erzeugt wirklich immer OLE-Objekte. Äusserst unschön, wenn man in einem RTI nur Attachments erwartet.

In diesen Fällen (OLE ist verboten) schmeisse ich diese im QueryClose nach entsprechendem Warnhinweis gleich wieder heraus. Vielleicht ist sowas ja schon die Lösung für das Problem von <Ich weiss leider nicht, wie der Fragesteller heisst>. Vor allem, da es ja so aussieht, als wenn er ein extra Feld für Anhänge hat - da kann man gleich das ganze Item herauswerfen und hat das Problem einfach gelöst.

Bernhard

TMC · « **Antwort #17 am:** 27.08.05 - 01:22:55 »

Bernhard, nein, das ist für "Mr. Cheech" keine Lösung, er schrieb oben dass es sich um eine App mit bestehenden Doks handelt, die eben jetzt alle durchlaufen werden sollen und Attachments auf Festplatte lösen.

Werde mir das gelegentlich doch nochmal in DXL ansehen, an die Tags kommt man easy, und der Rest sollte auch kein Problem sein, höchstens wenn da gewisse Header in die Datei geschrieben werden müssen, aber zumindest MS-Office, Adobe Acrobat etc. lässt sich da sicherlich abdecken, zumal eigentlich alle Daten im Tag "objectref" stehen sollten.

koehlerbv · « **Antwort #18 am:** 27.08.05 - 01:32:06 »

Oa ja, Matthias - ich habe das übersehen mit den bereits bestehenden Dokumenten. Sorry.

Bernhard

cheech · « **Antwort #19 am:** 27.08.05 - 11:26:45 »

Morgen Matthias !

Vielen Dank für die tolle Unterstützung. Ich habe es gestern mit meinem Script und hinzugefügte Attachments noch probiert, da hat es ohne Probleme funktioniert.

D.h. es ist ein Designfehler in der Datenbank.

Danke & Schönes Wochenende
Cheech