Herbers Excel/VBA-Archiv
| Informationen und Beispiele zum Thema InputBox | |
|---|---|
 Screenshot zu InputBox |
InputBox-Seite mit Beispielarbeitsmappe aufrufen |
| Informationen und Beispiele zum Thema Image | |
|---|---|
 Screenshot zu Image |
Image-Seite mit Beispielarbeitsmappe aufrufen |
Explorer auslesen
- Explorer auslesen von Markus vom 06.09.2004 09:16:11
- AW: Explorer auslesen - von Viktor am 06.09.2004 09:56:54
- AW: Explorer auslesen - von Markus am 06.09.2004 11:11:52
- AW: Explorer auslesen - von Markus am 06.09.2004 11:11:52
 |
Betrifft: Explorer auslesen
von: Markus
Geschrieben am: 06.09.2004 09:16:11
Hallo,
ich möchte alle Dateien (nur die Namen der Dateien), die in einem bestimmten Pfad stehen auslesen (inklusive Datum der letzten Änderung).
Kann mir jemand sagen, wie ich das anstelle?
Danke im Voraus
Markus
 |
Betrifft: AW: Explorer auslesen von: Viktor
Geschrieben am: 06.09.2004 09:56:54
Hallo Markus,
Code in ein Standard Modul einfügen:
'#############################
'Dieser Bereich kann entfallen,
'wenn der Variable 'Laufwerk'
'ein fester Wert zugewiesen wird.
Public 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 DeclareFunction SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long '############################# Private z! 'Ruft das Dialogfeld zur Ordnerauswahl aufFunction GetDirectory(Msg) As String Dim bInfo As BROWSEINFO Dim path As String Dim r As Long, x As Long, pos As Integer With bInfo .pidlRoot = 0& .lpszTitle = Msg .ulFlags = &H1 End With x = SHBrowseForFolder(bInfo) path = Space$(512) r = SHGetPathFromIDList(ByVal x, ByVal path) If r Then pos = InStr(path, Chr$(0)) GetDirectory = Left(path, pos - 1) Else GetDirectory = "" End If End FunctionSub Dateisuche(Laufwerk, Dateien) Dim tmp, Wdhlg, Dateiname As String On Error Resume Next If Right(Laufwerk, 1) <> "\" Then Laufwerk = Laufwerk + "\" tmp = Dir(Laufwerk & Dateien) Do While Len(tmp) Dateiname = Laufwerk & tmp Application.StatusBar = Dateiname Cells(z, 1).Select Cells(z, 1) = Laufwerk & tmp 'Pfad Cells(z, 2) = FileLen(Laufwerk & tmp) 'Größe Cells(z, 3) = FileDateTime(Laufwerk & tmp) 'Datum/Zeit Cells(z, 4) = tmp 'nur Dateiname z = z + 1 tmp = Dir() Loop tmp = Dir(Laufwerk, vbDirectory) Do While Len(tmp) If (tmp <> ".") And (tmp <> "..") Then If (GetAttr(Laufwerk & tmp) And vbDirectory) = vbDirectory Then Dateisuche Laufwerk & tmp, Dateien z = z - 1 Wdhlg = Dir(Laufwerk, vbDirectory) z = z + 1 Do While Wdhlg <> tmp Wdhlg = Dir() Loop End If End If tmp = Dir() Loop On Error GoTo 0 Application.StatusBar = False End Sub
'Aufruf mit dem folgenden MakroSub Suchen() Dim Laufwerk$, Dateien$ 'Ersze Zeile, in der eine Eintragung erfolgt z = 2 'Alte Eintragungen löschen [a1:e5000] = "" 'Den Variablen Laufwerk und Dateien kann 'auch ein direkter Wert zugewiesen werden. 'Ersatz: ... = "C:\Eigene Dateien" Laufwerk = GetDirectory("Bitte einen Ordner wählen") If Laufwerk = "" Then Exit Sub 'Ersatz: Dateien = "*.*" Dateien = InputBox("Nach welchen Dateien soll in" & _ Chr(10) & " " & Laufwerk & Chr(10) & _ "gesucht werden (z. B. *.xls)?", _ "Dateityp", "*.*") If Dateien = "" Then Exit Sub Dateisuche Laufwerk, Dateien End Sub
| |
Betrifft: AW: Explorer auslesen von: Markus
Geschrieben am: 06.09.2004 11:11:52
Ja super, dankeschön!!!!
| |