Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1556to1560
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Dateien suchen

Dateien suchen
17.05.2017 09:49:25
Matthias
Hallo!
Ich benötige Hilfe für folgendes Problem. Ich möchte über VBA Dateien auf einem Laufwerk finden und in einer Liste auflisten. Dazu habe ich bereits ein Beispiel gefunden, was grundsätzlich sehr gut funktioniert. Da ich jedoch über keinerlei VBA-Kenntnisse verfüge, macht mir die letzte Anpassung Probleme.
Zusätzlich möchte ich, das das VBA-Progrämmchen nur die Dateien aufgelistet, deren Dateiname so aussieht: kalk*.xlsm und von einem bestimmten Autor sind, Beispiel: VCH\m.ogzall
Hier ist die vorhandene VBA-Programmierung:
Option Explicit
Public Sub Dateienlisten()
'** Auswahl des auszuwertenden Ordner **
Dim Pfad As String, I As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ThisWorkbook.Path
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
Pfad = .SelectedItems(1)
Else
Exit Sub
End If
End With
'** Tabelle vorbereiten **
Cells.ClearContents
[A1].Select
[A1:F1] = Array("No.", "Path", "Filename", "Date", "Link", "Author")
[A1:F1].Font.Bold = True
'[C:C].WrapText = True
'[C:C].ColumnWidth = 20
[D:D].NumberFormat = "yyyy.mm.dd"
'[D:D].ColumnWidth = 10
[A1:F1].Interior.ColorIndex = 8
'** Sub list_files aufrufen , Spaltenbreite anpassen **
Call list_files([A2:F2], CreateObject("Scripting" & _
".FileSystemObject").GetFolder(Pfad))
[A:E].EntireColumn.AutoFit
'** Dateien nach Unterordner/Dateiname sortieren **
Range("A1").Sort _
Key1:=Range("B2"), Order1:=xlAscending, _
Key2:=Range("C2"), Order2:=xlAscending, _
Header:=xlYes
For I = 2 To Range("B" & Rows.Count).End(xlUp).Row
'Nummerieren
Range("A" & I) = I - 1
'Hyperlink hinzufügen
ActiveSheet.Hyperlinks.Add _
Anchor:=Range("E" & I), _
Address:=Range("B" & I) & IIf(Len(Range("B" & I)) > 0, "\" & _
"", "") & Range("C" & I), TextToDisplay:="Link"
Next
End Sub
'*****************************************
'** Dateien listen **
'*****************************************
Sub list_files(r As Range, ordner As Variant)
Dim file As Variant
Dim subordner As Variant
Dim wb As Workbook
Dim objShell, objFolder, objFile As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(CStr(ordner))
On Error GoTo ende
Application.ScreenUpdating = False
For Each file In ordner.Files
Set objFile = objFolder.ParseName(CStr(file.Name))
r(2) = Replace(ordner.Path, ThisWorkbook.Path & "\", "")
r(3) = file.Name
r(4) = DateValue(file.DateLastModified)
r(6) = objFolder.GetDetailsOf(objFile, 14)
r(6) = objFolder.GetDetailsOf(objFile, 10)
Set r = r.Offset(1)
Next
For Each subordner In ordner.SubFolders
If (subordner.Attributes And 4) = 0 Then '/System-Ordner/
Call list_files(r, subordner)
End If
Next
Range("A1").Select
ende:
Application.ScreenUpdating = True
End Sub Über Eure Hilfe wäre ich sehr dankbar!
Matthias

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateien suchen
17.05.2017 11:26:43
Michael
Hallo Matthias!
Dein erster Faden zu diesem Thema ist noch offen - warum legst Du einen zweiten an?
Folgender Code listet Dir auf dem Tabellenblatt "Tabelle1" (ggf. anpassen) alle Dateien des angegebenen Pfades (anpassen) auf, deren Dateiname bzw. Autor den angegebenen Filtern (anpassen) entsprechen:
Sub a()
Const PFAD$ = "C:\DeinVerzeichnis\..."
Const FILTERDNAME = "kalk*.xlsm"
Const FILTERAUTOR = "VCH\m.ogzall"
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Tabelle1")
Dim oSh As Object, oVerz As Object, f As Object
Dim i&, Dat$, Aut$
Set oSh = CreateObject("Shell.Application")
Set oVerz = oSh.Namespace(PFAD)
With Ws
If Not oVerz Is Nothing Then
For Each f In oVerz.items()
Dat = oVerz.getdetailsof(f, 0)
Aut = oVerz.getdetailsof(f, 10)
If Dat Like FILTERDNAME And _
Aut Like FILTERAUTOR Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = Dat
.Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0) = Aut
End If
Next f
End If
End With
End Sub
Passt?
LG
Michael
Anzeige
AW: Dateien suchen
17.05.2017 12:43:26
Matthias
Hallo Michael,
ich habe keine Antworten bekommen. Die Hilfe sagte mir, das man einfach einen neuen Beitrag erstellen soll, aber das Thema anders benennen soll...
Ich habe es getestet, aber das Tabellenblatt bleibt leer. Anpassen des Pfades, Suchen nach *.* hat es nicht geändert. Da versagt jetzt meine Kenntnis. Den Code kopieren und Einfügen schaffe ich. Nein, ich kann auch nachvollziehen, was da passieren müsste.
Grüße
Matthias
AW: Dateien suchen
17.05.2017 13:20:04
Michael
Hallo!
ich habe keine Antworten bekommen
Naja, zwei Tage sind jetzt nicht ewig, ist eben ein Forum. Auch wenn hier für gewöhnlich sehr schnell geantwortet wird, kann man's wohl nicht voraussetzen.
Ich habe es getestet
Ich ebenso, gerade nochmal, mein Code funktioniert. Ich kann daher aktuell nicht nachvollziehen, warum es bei Dir hakt.
Geh den Code mal in Einzelschritten durch (F8) und beobachte die Befüllung der Variablen "Dat" und "Aut"; wird da jemals in den Ausführungsteil der IF-Abfrage (.Cells... ) gegangen? Wenn nicht liegt's evtl. an den Filterbegriffen.
LG
Michael
Anzeige
AW: Dateien suchen
17.05.2017 14:13:19
Matthias
O.K, verstanden und getestet. Er springt nicht in den .Cell-Bereich. Mit den Filtern habe ich gespielt, aber wieder ohne Ergebnis. Excel macht irgendwas, schreibt aber nichts in die Tabelle. Dat und Aut durchläuft er, auch das If danach. Aber dann geht es bei Dat wieder los.
Grüße
Matthias
AW: Dateien suchen
17.05.2017 14:57:44
Michael
Hallo!
Er springt nicht in den .Cell-Bereich
Heißt, dass die zwei Vergleiche mit "Like" kein True ergeben.
Nimm eine Datei aus dem Verzeichnis, die aus Deiner Sicht auf jeden Fall von der Routine erfasst werden müsste (gem. Dateiname und Autor). Wie lautet zB der Dateiname oder Autor bzw. welche Werte haben an dieser Stelle (bei dieser Datei im Eizelschritt-Durchlauf der Routine) die Variablen "Dat" und "Aut"?
Wie gesagt, ich kann mich auch nur schrittweise herantasten, weil mein Code grds. funktioniert und der "Fehler" für mich nicht reproduzierbar ist.
LG
Michael
Anzeige
AW: Dateien suchen
17.05.2017 16:30:38
Matthias
Habe etwas herausgefunden: VCH\m.ogzall als Filter funzt nicht. "*" gibt alle Autoren raus. Dann wird auch etwas in die Tabelle geschrieben. Also passt was mit dem Filter des Autors nicht.
Grüße
Matthias
AW: Dateien suchen
17.05.2017 16:44:34
Michael
Hallo!
Na bitte, also stimmt der Code ;-) - ob/wie der Autor bei Deinen Dateien erfasst ist, kann ich leider nicht testen. Evtl. andere Strategie, versuch's mal so:
Sub a()
Const PFAD$ = "C:\DeinVerzeichnis\..."
Const FILTERDNAME = "kalk*.xlsm"
Const FILTERAUTOR = "VCH\m.ogzall"
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Tabelle1")
Dim oSh As Object, oVerz As Object, f As Object
Dim i&, Dat$, Aut$
Set oSh = CreateObject("Shell.Application")
Set oVerz = oSh.Namespace(PFAD)
With Ws
If Not oVerz Is Nothing Then
For Each f In oVerz.items()
Dat = oVerz.getdetailsof(f, 0)
Aut = oVerz.getdetailsof(f, 10)
If Dat Like FILTERDNAME And _
InStr(1, Aut, FILTERAUTOR) > 0 Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = Dat
.Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0) = Aut
End If
Next f
End If
End With
End Sub
Setze dabei die Konstante "FILTERAUTOR" nur auf einen Teil des gesuchten Namens bspw.
Const FILTERAUTOR = "ogzall"
LG
Michael
Anzeige
AW: Dateien suchen
18.05.2017 15:56:46
Matthias
Hallo Michael,
nein, leider nicht. Jetzt findet er gar nichts mehr.
Grüße
Matthias
AW: Sorry, kann ich nicht nachvollziehen...
18.05.2017 16:01:56
Michae
Matthias,
...sind bei den Dateien auch Autoren gesetzt?
Evtl. müssten wir das Verzeichnis einmal durchlaufen, und ALLE Namen und Autoren ausgeben - dann kann man sehen, ob bzw. welcher Filter funktionieren sollte.
Das schaffe ich heute aber nicht mehr, dazu morgen mehr.
LG
Michael
AW: Probe auf's Exempel...
19.05.2017 08:41:10
Michael
Morgen Matthias!
Ok, lass mal diesen Code (ist nur geringfügig anders als der bisherige) mit Deinem Verzeichnis durchlaufen, interessant wäre für mich hier natürlich die Liste, die dadurch auf Tabelle1 erzeugt wird...
Sub a()
Const PFAD$ = "C:\DeinVerzeichnis\..."
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Tabelle1")
Dim oSh As Object, oVerz As Object, f As Object
Dim Dat$, Aut$
Set oSh = CreateObject("Shell.Application")
Set oVerz = oSh.Namespace(PFAD)
With Ws
If Not oVerz Is Nothing Then
For Each f In oVerz.items()
Dat = oVerz.getdetailsof(f, 0)
Aut = oVerz.getdetailsof(f, 10)
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = Dat
.Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0) = Aut
If Dat Like "kalk*.xlsm" Then
.Cells(.Rows.Count, 3).End(xlUp).Offset(1, 0) = _
"Dateifilter OK"
End If
If Aut Like "VCH\m.ogzall" Then
.Cells(.Rows.Count, 4).End(xlUp).Offset(1, 0) = _
"Autorfilter OK"
End If
Next f
End If
End With
End Sub
LG
Michael
Anzeige
AW: Probe auf's Exempel...
19.05.2017 16:12:17
Matthias
Hallo Michael,
das funktioniert! VBE schreibt in Spalte A die Ordnerbezeichnung PR17121522_xxx und in Spalte B den Autor VCH\x.xxxxx
Hier ist es so, das der Autor jemand anderes ist, ich bin der, der zuletzt gespeichert hat, daher steht dort NICHT VCH\m.ogzall
Vielleicht kann man dafür ein ODER einbringen (Autor ODER letzter Speicherer = VCH\m.ogzall)?
Grüße
Matthias
Schaue ich mir an Mo ab, bin am WE nicht im Forum!
19.05.2017 16:16:41
Michael
AW: Kann ich leider nicht ergänzen...
22.05.2017 12:39:57
Michael
Matthias!
Bei meinen Tests (auf meinem Dateisystem) kann ich leider keinen Wert für "Letzter Speicherer" auslesen (mit der GetDetailsOf-Funktion). Meinen obigen Code kann ich Dir dahingehend also nicht anpassen.
LG
Michael
Anzeige
AW: Kann ich leider nicht ergänzen...
23.05.2017 08:59:36
Matthias
O.k., dann lasse ich die Übersicht über den Dateinamen erstellen und filtere vorerst händisch.
Grüße
Matthias
Alles klar, viel Erfolg! owT
23.05.2017 09:14:21
Michael

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige