Domino 9 und frühere Versionen > ND6: Entwicklung

Attachment exportieren

<< < (2/4) > >>

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

--- Ende Code ---


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


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

--- Ende Code ---

Danke
Cheech

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

--- Ende Zitat ---
Den hab ich erst gar nicht eingeschaltet  ;D 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 ?

--- Ende Zitat ---

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:
Die Msgbox ist auskommentiert, oder etwa nicht :-\

TMC:

--- Zitat von: tomtomtom am 26.08.05 - 23:51:53 ---Die Msgbox ist auskommentiert, oder etwa nicht :-\



--- Ende Zitat ---

Nein:


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

--- Ende Code ---

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

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

Navigation

[0] Themen-Index

[#] Nächste Seite

[*] Vorherige Sete