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.
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
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
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
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....
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
anbei der Code
Declaration
Dim sDir As String
Dim s As NotesSession
Dim w As NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
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
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
Die Msgbox ist auskommentiert, oder etwa nicht :-\
Nein:
Msgbox strTest, 64, "Folgende Attachments wurden erkannt:"
Eine andere ja, aber die tut jetzt wenig zur Sache, zeigt ja nur Item-Namen an :P
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.
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