Dateien in einem Verzeichnis auflisten und in Tabelle speichern

Question

Hallo zusammen

Ich möchte mir eine Access-DB erstellen, mit welcher ich die Dateinamen in einem Verzeichnis auflisten und in eine Tabelle speichern kann.

Weiss jemand, wie ich das in VBA machen kann?

Danke schon mal für die Hilfe!

Gruss Rolf

Answer 1

Du legst eine Tabelle an namens "deineTabelle" mit einem Feld namens "Dateiname". Den folgenden Code kopierst Du in ein Modul, dann kannst Du einen Button machen und "Einlesen" aufrufen durch Klick auf den Button. Es werden Dir sämtliche dateien mitsamt dem Pfadnamen eingetragen. Willst du nur den dateinamen, dann musst Du den Pfadnamen abschneiden. Wenn du nicht weisst wie das geht, dann schreib nochmal, ist kein Problem.

Der Code stammt nicht von mir, aber ich habe den Namen des Urhebers auch nicht parat.

Gruß marie

Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pIDList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
Private Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Verzeichnisse()
Private Dateien()
Private Anzdateien As Long
Private Dateiendung As String

Sub Einlesen()
Dim Ordnername
Dim Pfad1 As String
Dim Obergrenze As Long
Dim Anzordner As Long
Dim i As Long
Dim Start As Long
Dim CD_Bezeichnung As String
Dim rs As DAO.Recordset

Ordnername = Ordnerwählen("Ab welchem Verzeichnis einlesen?")
If Ordnername = False Then Exit Sub
ChDir Ordnername
'Wir gehen eine Ebene nach oben, damit wir von dort in dieses erste
'Verzeichnis wechseln können
ChDir ".."
If Ordnername <> "" Then
Anzdateien = 0
Pfad1 = Ordnername 'Arbeitspfad merken
If Right(Ordnername, 1) <> "\" Then Pfad1 = Pfad1 & "\"
ReDim Verzeichnisse(0) 'Die Hauptebene wird das 0. Element
Verzeichnisse(0) = Pfad1
Obergrenze = UBound(Verzeichnisse)
ReDim Dateien(0)
Rekursion:
For i = Start To Obergrenze
Verzeichnisse_suchen Verzeichnisse(i), Obergrenze
Start = Start + 1
Obergrenze = UBound(Verzeichnisse)
GoTo Rekursion
Next
Anzordner = Obergrenze + 1 'Für Anzeige; da Array mit 0 beginnt 1 dazu
'Lies in ein zweites Array alle Dateien aller gefundenen Verzeichnisse
'ein. Damit das Dateien-Array auch entsprechend erweitert werden kann,
'übergeben wirdie aktuelle Obergrenze als Startwert für neue
'Arrayelemente
For i = 0 To Obergrenze
Suche_Dateien Verzeichnisse(i), UBound(Dateien)
Next
'War die Dateisuche erfolglos?
If UBound(Dateien) = 0 Then
If Len(Dateien(0)) = 0 Then
'Es wurde nicht mal eine Excel-Datei gefunden
MsgBox "In keinem der " & Anzordner & " Ordner konnte " & _
"eine Datei gefunden werden. " & vbCr & _
"Es gibt nichts zu tun!", vbInformation + vbOKOnly, _
"Keine Dateien"
End If
Else
'Wir nehmen die letzte Ebene, die ein leeres Feld enthält,
'wieder raus.
Set rs = CurrentDb.OpenRecordset("deineTabelle")
ReDim Preserve Dateien(UBound(Dateien) - 1)
With rs
For i = 0 To UBound(Dateien)
.AddNew
!Dateiname = Dateien(i)
.Update
Next
End With
End If
End If
End Sub

Private Sub Verzeichnisse_suchen(ByVal Pfad As String, _
ByVal Arraygrenze As Long)
'Lies die Verzeichnisse in Pfad ein. Die Prozedur wird in OK_Click "rekursiv"
'aufgerufen, so dass wir ab einem Startverzeichnis eine Struktur einlesen
'können.
Dim Name1 As String

Name1 = Dir(Pfad, vbDirectory) ' Ersten Eintrag abrufen.
Do While Name1 <> "" ' Schleife beginnen.
' Aktuelles und übergeordnetes Verzeichnis ignorieren.
If Name1 <> "." And Name1 <> ".." Then
'Ist die gefundene Datei ein Verzeichnis?
If (GetAttr(Pfad & Name1) And vbDirectory) = vbDirectory Then
Arraygrenze = Arraygrenze + 1
ReDim Preserve Verzeichnisse(Arraygrenze)
Verzeichnisse(Arraygrenze) = Pfad & Name1 & "\"
End If
End If
Name1 = Dir 'Nächstes Verzeichnis finden
Loop
End Sub

Private Sub Suche_Dateien(ByVal Pfad As String, ByVal Arraygrenze As Long)
'Suche nach allen XL-Dateien im angegebenen Pfad
Dim Name2 As String

Name2 = Dir(Pfad & "*.*", vbNormal)
Do While Name2 <> ""
If (GetAttr(Pfad & Name2) And vbNormal) = vbNormal Then
ReDim Preserve Dateien(Arraygrenze + 1)
'Die Ebene, die wir hier vorsorglich schon mal erweitern,
'wird später wieder entfernt - aber erst ganz zum Schluss,
'wenn keine weiteren Dateien gefunden wurden.
Dateien(Arraygrenze) = Pfad & Name2
Arraygrenze = Arraygrenze + 1
Anzdateien = Anzdateien + 1
End If
Name2 = Dir()
Loop
End Sub

Private Function Ordnerwählen(ByVal strTitle As String) As String
'Stellt ein Windows-Dialogfeld zur Verfügung, mit dem sich ein beliebiger
'Ordner auswählen läßt.
'Entweder wird dieser oder (bei Abbruch) "" zurückgeliefert.
Dim lngIDList As Long
Dim strBuffer As String
Dim UserBrowseInfo As BrowseInfo

With UserBrowseInfo
.hwndOwner = 0
.lpszTitle = lstrcat(strTitle, "")
.ulFlags = 3
End With
lngIDList = SHBrowseForFolder(UserBrowseInfo)
If (lngIDList) Then
strBuffer = Space(260)
SHGetPathFromIDList lngIDList, strBuffer
strBuffer = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
Ordnerwählen = strBuffer
End If
End Function

Answer 2

Hallo Marie

Danke für deinen Code ...

Wenn ich ihn ausführen will, erhalte ich folgende Fehlermeldung:

Compile error: User defined type not defined

Diese Meldung wird durch folgende Zeile erzeugt:

Dim rs As DAO.Recordset


Ich hab schon mal rausgefunden, dass mein Access scheinbar das DAO nicht kennt (wenn ich "dim rs as " eingebe, erhalte ich eine Liste mit den möglichen Funktionen, aber DAO ist nicht dabei).

Ich verwende Access 2003 Englisch.

Gruss Rolf

Answer 3

Hallo Marie

Hab's rausgefunden... musste erst noch Microsoft DAO 3.6 Object Library referenzieren ...

Funktioniert also bestens ....

Das mit den Filenames sollte ich glaub schon hinbekommen :-)

Besten Dank nochmals für die Hilfe!

Gruss Rolf

Answer 4

na wenn nicht meldest Du dich nochmal

Gruß marie

Answer 5

Hallo Marie,

besten Dank für deinen Code, kann ich auch gut brauchen - ich muss zwar noch ein paar Sachen anpassen da ich den verzeichnisnamen und den dateinamen in jeweils einer eigenen spalte brauche, aber ich denke mal das sollte ich schaffen.

Ich hätte allerdings noch eine andere Frage dazu: welches Tool verwendest du um deine Codefragmente aufzuheben? Würd mich interessieren da ich bisher irgendwie noch kein optimales gefunden habe bzw. vielleicht auch einfach zu wenig gesucht habe.

Danke
Thomas

Answer 6

Ich weiß wo in meinen Programmen was vorkommt, den Rest finde ich leider auch oft nicht mehr.

Gruß marie