Anhänge ausgewählter Dokumente in ein Verzeichnis lösen

[TMC]

Hi,

den Tipp hier finde ich prima, daher poste ich den hier nochmal.

Damit werden alle Anhänge der ausgewählten Dokumente in ein Verzeichnis gelöst. Dabei erscheint ein Ordner-Auswahl-Requester, in dem man bequem das Verzeichnis wählen kann.

1. Als Function einfügen

Code

Function BrowseFolder (path As String, windowtitle As String) As String
   
   Dim X As Long, bi As BROWSEINFO, dwIList As Long
   Dim wPos As Integer
   Dim cam2 As String
   
   bi.pszDisplayName = path
   bi.hOwner = hWndAccessApp
   bi.lpszTitle = title
   bi.ulFlags = BIF_RETURNONLYFSDIRS
   
   dwIList = SHBrowseForFolder (bi)
   cam2 = Space$(512)
   X = SHGetPathFromIDList(Byval dwIList, Byval cam2)
   
   If X Then
      wPos = Instr (cam2, Chr(0))
      BrowseFolder = Left$ (cam2, wPos - 1)
   Else
      BrowseFolder = ""
   End If
   
End Function

2. Unter Declarations rein

Code

Type BROWSEINFO
   hOwner As Long
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfn As Long
   lParam As Long
   iImage As Long
End Type
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (Byval pidl As Long, Byval pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

3. Eigentliches Script

Code

Sub Click(Source As Button)
   Dim ws As New NotesUIWorkspace
   Dim session As New NotesSession
   Dim db As NotesDatabase
   Dim collection As NotesDocumentCollection
   Dim doc As NotesDocument
   Dim rtitem As Variant
   Dim folder As String
   folder = BrowseFolder ("","")
   Set db = session.CurrentDatabase
   Set collection = db.UnprocessedDocuments
   Set doc = collection.GetFirstDocument
   
   While Not (doc Is Nothing)
      
      Set rtitem = doc.GetFirstItem( "Inhalt" ) 'Hier das entsprechende RT-Feld angeben
      If ( rtitem.Type = RICHTEXT ) Then
         Forall o In rtitem.EmbeddedObjects
            Call o.ExtractFile(  folder+"\"  & o.Name )
         End Forall
      End If
      Set doc = collection.GetNextDocument(doc)
   Wend
End Sub

Gruss,
TMC

[zapfbay]

Hallo zusammen!

Vielleicht stelle ich mich etwas "doof" an, aber kann es sein, dass das Skript unter Notes 8.5 nicht funktioniert?

Gruß

[koehlerbv]

Nein, dass kann nicht sein (das "richtige" Betriebssystem vorausgesetzt.

Bernhard

[Axel]

...aber kann es sein, dass das Skript unter Notes 8.5 nicht funktioniert?

Kann es sein, dass deine Informationen für eine Hilfestellung etwas zu dürftig sind?

Unsere Kristallkugeln befinden sich gerade in der Inspektion.   

Was nutzt du für ein Betriebssystem? Bekommst du Fehlermeldungen angezeigt? Wenn ja, welche?
Was sagt der Debugger zu dem Thema? An welcher Stelle steigt das Script aus?

Merke: Je mehr Infos du lieferst und um so detailierter du das Problem beschreibst, desto schneller und besser kann die geholfen werden.

Axel