Office: Dateien in Listbox auflisten und durch Dbl-Click öffnen

aloys78 · 8. Juli 2013

Hallo Tobias,

noch 2 Fragen:
- um wieviel Unterordner und Dateien geht es pro Pfad (Größenordnung) ?
- sind die Dateinamen in den verschiedenen Unterordnern eindeutig ?
(ansonsten müßte man zB in der Listbox den Pfad mit anzeigen)

Gruß
Aloys

aloys78 · 9. Juli 2013

Hallo Tobias,

Bleibt nur noch das verflixte Problem mit den Unterordnern.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich unterstelle mal, dass die Dateinamen in der jeweiligen Ordnerstruktur eindeutig sind. Um Unterordner mit berücksichtigen zu können, waren die Prozeduren für die Userform anzupassen und der Code im Modul zu ergänzen.

Nachstehend der neue Code für Userform und Modul.

Gruß
Aloys

********* Userform ****************
Code:

Option Explicit

Private Sub Schließen_Click()
Unload VertriebForm
End Sub

Private Sub Userform_Initialize()
Dim Ordner() As Variant 'Array für die Pfade aller Unterordner
Dim xo As Long 'Index für Array Ordner
Dim sPfad As String 'Pfad Unterodner
Dim f As Long 'Index für die beiden Arays
Dim j As Long

ReDim x_x(0)
x_i = 0
Ordner = allfolders(strPath) 'alle Unterordner im Array Ordner speichern
f = 0
For xo = 0 To UBound(Ordner) 'Haupt- und Unterordner abarbeiten
'für jeden Ordner /Unterordner kompletten Pfad in 'sPfad' speichern
If xo = 0 Then
strFile = Dir(strPath & "*.pdf") 'Hauptordner
sPfad = strPath
Else
strFile = Dir(Ordner(xo) & "\*.pdf") 'Subordner
sPfad = Ordner(xo) & "\"
End If
Do While strFile ""
'alle Dateinamen und ihre zugehörigen Pfad in Arrays ablegen
f = f + 1
ReDim Preserve arr_F(1 To f)
arr_F(f) = strFile 'Dateinamen
ReDim Preserve arr_P(1 To f)
arr_P(f) = sPfad 'zugehöriger Pfad
'für Testzwecke: auflisten Dateinamen und zugehörigen Pfad
'Range("A" & f) = arr_F(f)
'Range("B" & f) = arr_P(f)
'Listbox füllen
'ListBox1.ColumnCount = 2
ListBox1.AddItem strFile
ListBox1.List(j, 1) = Format(FileDateTime(sPfad & "\" & strFile), "dd.mm.yyyy")
j = j + 1
strFile = Dir
Loop
Next xo
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim f As Long 'Index für Arrays
Dim sPfad As String
If Me.ListBox1.ListIndex = -1 Then
Exit Sub
End If
'ausgewählten Dateinamen speichern
strFile = ListBox1.Text 'ausgewählter Dateiname
sPfad = ""
'zugehörigen Pfad suchen
For f = 1 To UBound(arr_F)
If arr_F(f) = strFile Then
sPfad = arr_P(f)
Exit For
End If
Next f
'wenn zugehöriger Ordner/Unterordner gefunden, Datei öffnen
If Dir(sPfad & strFile) "" Then
Open_File sPfad & strFile, 1
Else
MsgBox "Datei-Pfad für " & strFile & " nicht gefunden !" 'Fehler dürfte nicht vorkommen
End If
Me.ListBox1.ListIndex = -1
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

********* Modul ****************
Code:

Option Explicit
Option Base 0
Public strFile As String 'globaler Dateiname
Public strPath As String 'globaler Pfadname
Public x_x() 'für Functio allfolders(
Public x_i As Long 'für Functio allfolders(
Public arr_F() As String 'Array Dateinamen
Public arr_P() As String 'Array korrespondierende Dateipfade

Private Declare Function ShellExecute Lib "SHELL32.DLL" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Sub Open_File(strFile As String, windowType As Integer)
ShellExecute &H3, "Open", strFile, "", "", windowType
End Sub

Function allfolders(foldspec)
'**********************************************************
' Unterordner lesen und speichern
'**********************************************************
Dim fs, f, f1, fc
Dim n As Integer
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(foldspec)
Set fc = f.SubFolders
n = fc.Count
For Each f1 In fc
If n > 0 Then x_i = x_i + 1
ReDim Preserve x_x(x_i)
x_x(x_i) = foldspec & f1.Name
allfolders (x_x(x_i) & "\") 'rekursiver Funktionsaufruf!!!
Next
allfolders = x_x
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: Dateien in Listbox auflisten und durch Dbl-Click öffnen

Dateien in Listbox auflisten und durch Dbl-Click öffnen

Dateien in Listbox auflisten und durch Dbl-Click öffnen

Dateien in Listbox auflisten und durch Dbl-Click öffnen - Similar Threads - Dateien Listbox auflisten

Performance bei vielen SVERWEIS-Funktionen & Datei-Design für große Datenmengen

Kann keine .msg Dateien öffnen

Struktur PST Datei zerschossen

Access Datei wird per Makro nicht gespeichert

VBA7, Declare Function FindWindow Lib

Excel 2010 - Link zum Start Video-Datei mit Listbox und CB in Userform erstellen

PDF-Datei in der Listbox auswählen und Datei löschen