Domino 9 und frühere Versionen > ND6: Entwicklung

Attachment exportieren

(1/4) > >>

cheech:
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

--- Ende Code ---

Danke für eure Hilfe
Cheech

Axel:
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:
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


--- Ende Code ---

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

Danke
Cheech

TMC:
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

--- Ende Code ---

cheech:
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

Navigation

[0] Themen-Index

[#] Nächste Seite

Zur normalen Ansicht wechseln