Filer2

Det har jeg også søgt længe men uden resutat !

Faktisk tror jeg at vi skal bruge en ocx/dll skrevet i C/C++

Jeg vil gerne bidrage med ligt point hvis der er en Ekspert som kan hjælpe os med problemet

Jeg har fundet noget på nettet, som i måske kan bruge. Jeg har desværre ikke haft tid til at efterprøve koden, men der ser nogenlunde ud :-).

Public Sub PathLogInit()
\'PURPOSE: Create & initialize objFSO as a
\'FileSystemObject object.
\'Call this procedure from the LOAD event of the Startup form.
Set objFSO = New FileSystemObject
End Sub

Public Sub LogPath(strPARENT As String, strFNAMES() As String, _
                  lngPptrs() As Long, strPaths() As String)
\'PURPOSE: Make a list of all the files in a Folder and all of
\'its subfolders.

\'Typically used with a DirListBox control on a form. A command
\'button should be provided to run this procedure. After selecting
\'a folder in the DirListBox, the user would click the button to
\' log the folder and its subfolders (which is the Path).

\'The calling form or module passes a string of the path,
\'a variable array of strings for the subfolder names, a
\'variable array of long integers for the pointers to the
\'folder names, & a variable array of strings for the filenames.

\'EXAMPLE:
\' LogPath Dir1.Path, arrayFolders, arrayPointers, arrayFilenames

\'The result in arrayFilenames can be used to fill a listbox.
\'A filename selected in a listbox can be fully referenced by
\'combining it with its parent folder name,
\' thus: arrayFolders(arrayPointers(I)) & arrayFilenames(I)

Dim lngTopIndex As Long
Dim lngPathIndex As Long
Dim strNextPath As String
\'if path is invalid, exit
If Not objFSO.FolderExists(strPARENT) Then Exit Sub

\' \"seed\" the loop
lngTopIndex = 0
lngPathIndex = 0
lngFNAMEScntr = 0
ReDim strPaths(0)
strPaths(0) = IFBACKSLASH(strPARENT)

\'reset the filename and pathpointer arrays just in case no
\'filenames match the wildcard pattern
ReDim strFNAMES(0)
ReDim lngPptrs(0)

Do

\' Add subfolders, if any, to array
  Set objFolders = _
          objFSO.GetFolder(strPaths(lngPathIndex)).SubFolders
  For Each objFolder In objFolders
    lngTopIndex = lngTopIndex + 1
    ReDim Preserve strPaths(lngTopIndex)
    strPaths(lngTopIndex) = strPaths(lngPathIndex) & _
                            objFolder.Name & \"\\\"
  Next
 
\' Add filenames, if any, to array
  Set objFiles = objFSO.GetFolder(strPaths(lngPathIndex)).Files
  For Each objFile In objFiles
    ReDim Preserve strFNAMES(lngFNAMEScntr)
    strFNAMES(lngFNAMEScntr) = objFile.Name
    ReDim Preserve lngPptrs(lngFNAMEScntr)
    lngPptrs(lngFNAMEScntr) = lngPathIndex
    lngFNAMEScntr = lngFNAMEScntr + 1
  Next
   
\' Point to next entry in subfolder array
  lngPathIndex = lngPathIndex + 1
 
\' If there are no more subfolders, exit
  Loop Until lngPathIndex > lngTopIndex
 
End Sub

Public Property Get Count() As Long
\' Get the number of filenames found
Count = lngFNAMEScntr
End Property

Public Sub Terminate()
\' Clear all the objects from memory
Set objFSO = Nothing
Set objFiles = Nothing
Set objFile = Nothing
Set objFolders = Nothing
Set objFolder = Nothing
End Sub

Private Function IFBACKSLASH(strX As String) As String
\' function for fixing the DOS path of a root directory
IFBACKSLASH = IIf(Right(strX, 1) = \"\\\", strX, strX & \"\\\")
End Function

Håber i kan bruge det til noget :-)

Ups! jeg tror at jeg har lavet en lille fejl. Jeg er ikke sikker på at algoritmen søger igennem undermapperne.

Man kan evt. løse det vha. at bruge en wrapper funktion, der bruger LogPath(). Denne funktion skal så selv finde ud af at kalde LogPath() med de undermapper som den selv returnerer. Noget ala (pseudokode, sidder ikke ved VB):

Public Sub ListFiles(startDir As String)
  Dim fileNames() As String
  Dim pointers() As Long
  Dim subFolders() As String
  Dim i As Integer
 
  LogPath startDir, subFolders, pointers, fileNames
 
  \' Udskriv filer i mappen
  For i = LBound(fileNames) To UBound(fileNames)
    Debug.Print fileNames(i)
  Next i
 
  \' Søg rekursiv videre i alle de fundne submapper
  For i = LBound(subFolders) To UBound(subFolders)
    ListFiles subFolders(i)
  Next i

End Sub