Lotus Notes / Domino Sonstiges > Tipps und Tricks

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

(1/1)

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

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

--- Ende Code ---

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


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:

--- Zitat von: zapfbay am 01.02.11 - 08:10:22 ---...aber kann es sein, dass das Skript unter Notes 8.5 nicht funktioniert?

--- Ende Zitat ---

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

Navigation

[0] Themen-Index