Dateiinformationen auslesen und in Excel erfassen per VBA-Code
mskippi
ich bin ziemlich unerfahren, was den Umgang mit VBA angeht, möchte
aber dennoch für meine Tätigkeit einkleines Skript entwerfen, welches
mir Dateien aus einem ausgewählten Ordner auflistet und mit diesen
verlinkt.
Vielleicht kann mir ja jemand aus dem Forum weiterhelfen. Ich stecke
fest und habe keine Idee, wie ich nun das Werk vollenden könnte.
Die Idee:
Per VBA soll eine Tabelle mit einer Dateiliste gefüllt werden. Die
Auswahl soll via Eingabeaufforderung erfolgen (besser noch per
Auswahlmenu), eine zusätzlicher Filter für das Dateiformat wäre schön.
Benötigte Informationen:
Pfad (relativ zum angegebenen Ordner inkl. weiterer Unterordner)
Dateiname/ Dateiendung
Link zum Öffnen der jeweiligen Datei aus Excel heraus
Kommentar (später von Hand eingegeben)
Der Link für die gelisteten Dateien solle soll auch nur die
Bezeichnung „Link haben und in der Zelle neben dem Dateinamen
stehen.Schließlich sollen die Zeilen nach Pfad sortiert und nummeriert
werden.
Was ich bisher habe:
Mit einem Code von Peter Schleif aus diesem Forum (Danke dafür)
weiteren Ideen aus anderen Quellen und wenigen eigenen Ergüssen, habe
ich den unten angefügten Code erstellt.
Ich kann einen Pfad per Eingabeaufforderung eintragen, die Dateien
werden gelistet und nummeriert. Der Pfad wird allerdings absolut
gelistet.
Was mir fehlt:
Die Verlinkung der Dateien, und die bessere Variante mit Auswahlmenu
für den zu listenden Ordner.
Der relative Pfad zum ausgewählten Ordner.
Und nicht zu vergessen der Dateifilter.Das Sortieren (klappt, ist aber
möglicherweise gar nicht nötig)
Ich wäre über jede Hilfe dankbar.
Gruß
Markus
Hier der bisherige Code
Sub DateiInformationen()
Dim PFAD As String, sTxt As String
PFAD = InputBox( _
prompt:="Pfad:", Default:="C:\\")
If Right(PFAD, 1) <> "\" Then PFAD = PFAD & "\"
Cells.Select
Selection.ClearContents
With ThisWorkbook.Worksheets("Tabelle1")
.[A1].Select
.[A1:E1] = Array("No.", "Path", "Filename", "Link", "Comment")
'"comment" muss von Hand eingetragen werden!!
Call list_files(.[A2:E2], CreateObject( _
"Scripting.FileSystemObject").GetFolder(PFAD))
.[A:E].EntireColumn.AutoFit
End With
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
' nicht leere Zeilen nummerieren
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Dim rng As Range, a As Variant, t As Long, z As Long
Dim amax As Long, bmax As Long
amax = Range("C65536").End(xlUp).Row
bmax = Range("B65536").End(xlUp).Row
If amax < bmax Then amax = bmax
Set rng = Range("b2:c" & amax)
a = Range("a2:a" & amax)
For t = 1 To UBound(a)
If rng.Cells(t, 1).Font.Bold Then a(t, 1) = "x"
If rng(t, 1) = "" And rng(t, 2) = "" Then a(t, 1) = "x"
Next
For t = 1 To UBound(a)
If a(t, 1) = "x" Then
a(t, 1) = ""
Else
z = z + 1
a(t, 1) = z
End If
Next
End Sub
Sub list_files(r As Range, ordner As Variant)
Dim file As Variant
Dim subordner As Variant
Dim wb As Workbook
On Error GoTo ende
Application.ScreenUpdating = False
For Each file In ordner.Files
r(2) = ordner.Path
r(3) = file.Name
'r(3) = DateValue(file.DateLastModified)
'r(4) = file.Size
'r(3) = TimeValue(file.DateLastModified)
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
Cells.Select
Range("A37").Activate
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending,
Key2:=Range("C2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
:=xlSortNormal
Range("A1").Select
ende:
Application.ScreenUpdating = True
End Sub
Andreas Killer
> Per VBA soll eine Tabelle mit einer Dateiliste gefüllt werden. Die
> Auswahl soll via Eingabeaufforderung erfolgen (besser noch per
> Auswahlmenu), eine zusätzlicher Filter für das Dateiformat wäre schön.
Dann würde ich aber GetOpenFileName statt der InputBox nehmen.
> Benötigte Informationen:
> Pfad (relativ zum angegebenen Ordner inkl. weiterer Unterordner)
> Dateiname/ Dateiendung
> Link zum Öffnen der jeweiligen Datei aus Excel heraus
> Kommentar (später von Hand eingegeben)
>
> Der Link für die gelisteten Dateien solle soll auch nur die
> Bezeichnung „Link haben und in der Zelle neben dem Dateinamen
> stehen.Schließlich sollen die Zeilen nach Pfad sortiert und nummeriert
> werden.
Ja, klingt machbar.
Kuck mal in den Thread "GetOpenFileName", hatte ich gerade heute
morgen gepostet und probier mal den Code aus.
Den Pfad von den Dateinamen wegschneiden ist kein Problem und ein
Hyperlink auf die Datei zu legen auch nicht, sortieren sowieso nicht.
Aber bevor ich das mache beantworte bitte diese Fragen:
In Spalte B soll der Dateiname? Mit oder ohne Endung? Falls ohne:
In welche Spalte soll die Endung? Keine?
In Spalte A der Text "Link" mit einem Hyperlink auf die Datei?
Das ganze sortiert nach den Pfadangaben (die nicht mehr da sind)?
Oder soll der Pfad auch gespeichert werden? Wenn ja in welcher Spalte?
> Was ich bisher habe:
Puh, das ist mir zu unstrukturiert, das würde ich verwerfen.
Andreas.
mskippi
> On 24 Feb., 14:50, mskippi <m...@stein-lohne.de> wrote:
>
> > Per VBA soll eine Tabelle mit einer Dateiliste gefüllt werden. Die
> > Auswahl soll via Eingabeaufforderung erfolgen (besser noch per
> > Auswahlmenu), eine zusätzlicher Filter für das Dateiformat wäre schön.
>
> Dann würde ich aber GetOpenFileName statt der InputBox nehmen.
>
> > Benötigte Informationen:
> > Pfad (relativ zum angegebenen Ordner inkl. weiterer Unterordner)
> > Dateiname/ Dateiendung
> > Link zum Öffnen der jeweiligen Datei aus Excel heraus
> > Kommentar (später von Hand eingegeben)
>
> > Der Link für die gelisteten Dateien solle soll auch nur die
> > Bezeichnung „Link haben und in der Zelle neben dem Dateinamen
> > werden.
>
> Ja, klingt machbar.
>
> Kuck mal in den Thread "GetOpenFileName", hatte ich gerade heute
> morgen gepostet und probier mal den Code aus.
>
> Den Pfad von den Dateinamen wegschneiden ist kein Problem und ein
> Hyperlink auf die Datei zu legen auch nicht, sortieren sowieso nicht.
>
> Aber bevor ich das mache beantworte bitte diese Fragen:
>
> In Spalte B soll der Dateiname? Mit oder ohne Endung? Falls ohne:
> In welche Spalte soll die Endung? Keine?
> In Spalte A der Text "Link" mit einem Hyperlink auf die Datei?
> Das ganze sortiert nach den Pfadangaben (die nicht mehr da sind)?
> Oder soll der Pfad auch gespeichert werden? Wenn ja in welcher Spalte?
>
> > Was ich bisher habe:
>
> Puh, das ist mir zu unstrukturiert, das würde ich verwerfen.
>
> Andreas.
Hallo Andreas,
vielen Dank erst einmal für Deine schnelle Antwort.
Zu Deinen Rückfragen:
> Kuck mal in den Thread "GetOpenFileName", hatte ich gerade heute
> morgen gepostet und probier mal den Code aus.
Habe ich getan. Der Dialog öffnet sich, ich kann einzelne oder mehrere
Dateien auswählen, soweit gut.
Allerdings würde ich gerne einen Pfad auswählen, aus dem dann
sämtliche Unterordner und Dateien gelistet werden.
Ich muss mal schauen, ob ich das angepasst bekomme.
> Den Pfad von den Dateinamen wegschneiden ist kein Problem und ein
> Hyperlink auf die Datei zu legen auch nicht, sortieren sowieso nicht.
> Aber bevor ich das mache beantworte bitte diese Fragen:
> In Spalte B soll der Dateiname? Mit oder ohne Endung? Falls ohne:
> In welche Spalte soll die Endung? Keine?
> In Spalte A der Text "Link" mit einem Hyperlink auf die Datei?
> Das ganze sortiert nach den Pfadangaben (die nicht mehr da sind)?
> Oder soll der Pfad auch gespeichert werden? Wenn ja in welcher Spalte?
Also in Spalte A soll eine laufende Nummerierung der gelisteten
Dateien,
in Spalte B der Pfad, (in welcher Form, siehe unten)
in Spalte C der Dateiname mit Endung,
in Spalte D der Text "Link" mit entsprechender Verknüpfung zur Datei
aus Spalte C, (so, das der übergeordnete Ordner samt Unterordner und
Dateien kopiert und an anderer Stelle weiter genutzt wwerden kann)
in Spalte E kommt dann später per Handeintrag noch ein Kommentar.
(Dieses würde ich zwar auch gerne aus den Dateiinfos auslesen, da aber
dazu die jeweilige Datei geöffnet werden muss, habe ich diese Idee
vorerst verworfen)
Die zu erstellende Excelliste liegt in irgendeinem Ordner. (z.B. C:\
\Projekt xy\Daten an Kunde\Liste.xls)
Alle zu listenden Dateien liegen im selben Ordner aber in verschiedene
Unterordner sortiert.
Die Angabe für den Pfad sollen nur die Unterordner listen. Also der
Teil "C:\\Projekt xy\Daten an Kunde\" soll entfallen. (z.B. "..
\Zeichnungen\Anklage I", oder ..\Zeichnungen\Anlage II)
Das sortieren dann in alphabetischer Folge der Unterordner und
Dateien. (ist aber nicht ganz so wichtig)
>>Was ich bisher habe:
> Puh, das ist mir zu unstrukturiert, das würde ich verwerfen.
Wie gesagt, ich bin sehr unerfahren.
Danke, dass Du dich meinem Problem annimmst,
ich glaube (nein ich weiß), ich habe mich da ziemlich übernommen.
Gruß
Markus
Andreas Killer
> > Kuck mal in den Thread "GetOpenFileName", hatte ich gerade heute
> > morgen gepostet und probier mal den Code aus.
> Habe ich getan. Der Dialog öffnet sich, ich kann einzelne oder mehrere
> Dateien auswählen, soweit gut.
> Allerdings würde ich gerne einen Pfad auswählen, aus dem dann
> sämtliche Unterordner und Dateien gelistet werden.
> Ich muss mal schauen, ob ich das angepasst bekomme.
Nö, das geht nicht, mit GetOpenFilename kannst Du keinen Pfad
auswählen. Ich häng Dir mal einen Code dran, starte mal die Sub Test,
die zeigt Dir den Dialog, mehr passiert noch nicht.
> Also in Spalte A soll eine laufende Nummerierung der gelisteten
> Dateien,
Nummeriert wonach? Nach Größe, Datum, Name der Datei?
> in Spalte B der Pfad, (in welcher Form, siehe unten)
Wie wo unten? Also soll der Pfad der Mappe entfallen?
> in Spalte C der Dateiname mit Endung,
> in Spalte D der Text "Link" mit entsprechender Verknüpfung zur Datei
> aus Spalte C, (so, das der übergeordnete Ordner samt Unterordner und
> Dateien kopiert und an anderer Stelle weiter genutzt wwerden kann)
Text "Link" okay, Verknüpfung okay, aber was willst Du wie kopieren
und an anderer Stelle weiternutzen???
Du kannst den Link (die Zelle in der er steht) kopieren, aber das hat
keinerlei Einfluss auf die Datei, geschweige denn den Ordner.
> Die zu erstellende Excelliste liegt in irgendeinem Ordner. (z.B. C:\
> \Projekt xy\Daten an Kunde\Liste.xls)
>
> Alle zu listenden Dateien liegen im selben Ordner aber in verschiedene
> Unterordner sortiert.
Okay, der Startpfad ist der Pfad der Mappe, kein Ding.
Noch 'ne Frage: Welche unter Excelversion soll das laufen?
Andreas.
Option Explicit
'Optionflags des ShellGetFolder-Dialogs
Enum vbShellGetFolderFlags
BIF_RETURNONLYFSDIRS = &H1
BIF_DONTGOBELOWDOMAIN = &H2
BIF_STATUSTEXT = &H4
BIF_RETURNFSANCESTORS = &H8
BIF_EDITBOX = &H10
BIF_VALIDATE = &H20
BIF_NEWDIALOGSTYLE = &H40
BIF_BROWSEINCLUDEURLS = &H80
BIF_BROWSEFORCOMPUTER = &H1000
BIF_BROWSEFORPRINTER = &H2000
BIF_BROWSEINCLUDEFILES = &H4000
BIF_SHAREABLE = &H8000
BIF_SHOWALLOBJECTS = &H8
End Enum
Const BIF_DefaultOptions = BIF_EDITBOX Or BIF_VALIDATE Or _
BIF_SHOWALLOBJECTS Or BIF_STATUSTEXT Or BIF_NEWDIALOGSTYLE
Const BIF_BrowseFolder = BIF_RETURNONLYFSDIRS Or _
BIF_DefaultOptions
Const ssfDESKTOP = &H0 'Desktop
Const ssfPROGRAMS = &H2 'Programme Startmenü (alle Benutzer)
Const ssfCONTROLS = &H3 'Systemsteuerung
Const ssfPRINTERS = &H4 'Drucker
Const ssfPERSONAL = &H5 'Eigene Dateien (aktueller Benutzer)
Const ssfFAVORITES = &H6 'Favoriten (aktueller Benutzer)
Const ssfSTARTUP = &H7 'Autostart
Const ssfRECENT = &H8 'Zuletzt verwendete Dokumente
Const ssfSENDTO = &H9 'Senden an - Ordner
Const ssfBITBUCKET = &HA 'Recycled (Papierkorb)
Const ssfSTARTMENU = &HB 'Startmenü (aktueller Benutzer)
'Desktop - Ordner (aktueller Benutzer)
Const ssfDESKTOPDIRECTORY = &H10
Const ssfDRIVES = &H11 'Arbeitsplatz
Const ssfNETWORK = &H12 'Netzwerkumgebung
Const ssfNETHOOD = &H13 'Netzwerkumgebung - Ordner
Const ssfFONTS = &H14 'Schriftarten - Ordner
Const ssfTEMPLATES = &H15 'Vorlagen - Ordner
Const ssfCOMMONSTARTMENU = &H16 'Startmenü (alle Benutzer)
'Programme Startmenü (alle Benutzer)
Const ssfCOMMONPROGRAMS = &H17
Const ssfCOMMONSTARTUP = &H18 'Autostart (alle Benutzer)
'Desktop - Ordner (alle Benutzer)
Const ssfCOMMONDESKTOPDIR = &H18
Const ssfAPPDATA = &H1A 'Anwendungsdaten (aktueller Benutzer)
Const ssfLOCALAPPDATA = &H1C '
Const ssfPRINTHOOD = &H1B 'Druckumgebung - Ordner
'Altern. Autostart - Ordner (aktueller Benutzer)
Const ssfALTSTARTUP = &H1D
'Altern. Autostart - Ordner (alle Benutzer)
Const ssfCOMMONALTSTARTUP = &H1E
Const ssfCOMMONFAVORITES = &H1F 'Favoriten (alle Benutzer)
Const ssfINTERNETCACHE = &H20 'Temporäre Internetdateien
Const ssfCOOKIES = &H21 'Internet Cookies - Ordner
Const ssfHISTORY = &H22 'Internet Verlauf - Ordner
Const ssfCOMMONAPPDATA = &H23 'Anwendungsdaten <alle Benutzer>
Const ssfWINDOWS = &H24 'Windows-Ordner
Const ssfSYSTEM = &H25 'System-Ordner
Const ssfPROGRAMFILES = &H26 'Programme
Const ssfMYPICTURES = &H27 'Eigene Bilder
Const ssfPROFILE = &H28 'Dokumente und Einstellungen
Const ssfPROGRAMFILESCOMMON = &H2B 'Gemeinsame Dateien
'Vorlagen - Ordner (alle Benutzer)
Const ssfCOMMONTEMPLATES = &H2D
Const ssfCOMMONDOCUMENTS = &H2E 'Dokumente (alle Benutzer)
'Startmenü "Verwaltung" (alle Benutzer)
Const ssfCOMMONADMINTOOLS = &H2F
'Startmenü "Verwaltung" (aktueller Benutzer)
Const ssfADMINTOOLS = &H30
Const ssfCONNECTIONS = &H31 'Netzwerk- und DFÜ-Verbindungen
Sub Test()
Dim S As String
S = GetOpenFolderName(ThisWorkbook.Path, "Pfad auswählen:")
End Sub
Function ShellGetFolder( _
Optional Path As Variant = ssfDRIVES, _
Optional Caption As String = "", _
Optional Options As vbShellGetFolderFlags = _
BIF_DefaultOptions) As String
'Ruft einen Dialog auf, gibt das ausgewählte Objekt zurück
Dim objShell As Object, objBrowse As Object
On Error Resume Next
Set objShell = CreateObject("Shell.Application")
'Dialog starten und Path zurückgeben
If IsNumeric(Path) Then
'Anfangspfad als Konstante
Set objBrowse = objShell.BrowseForFolder(&H0, Caption, _
Options, CLng(Path))
Else
'Anfangspfad als String
Set objBrowse = objShell.BrowseForFolder(&H0, Caption, _
Options, Path & Chr(0))
End If
objBrowse.ParentFolder.ParseName objBrowse.Title
ShellGetFolder = objBrowse.Self.Path
End Function
Function GetOpenFolderName(Optional ByVal Pfad As String = "", _
Optional Msg As String = "") As String
'Zeigt das Dialogfeld "Ordner suchen", liefert den _
Ordnernamen oder "" für Abbruch
GetOpenFolderName = ShellGetFolder(Pfad, Msg, BIF_BrowseFolder)
'alte Version
'Private 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
'
'Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
' Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
pszPath As String) As Long
'
'Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
' Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long
'
' Dim bInfo As BROWSEINFO
' Dim Path As String
' Dim R As Long, X As Long, Pos As Integer
' bInfo.pidlRoot = 0&
' If Msg = "" Then
' bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
' Else
' bInfo.lpszTitle = Msg
' End If
' bInfo.ulFlags = &H1
' X = SHBrowseForFolder(bInfo)
' Path = Space$(512)
' R = SHGetPathFromIDList(X, Path)
' If R Then
' Pos = InStr(Path, Chr$(0))
' GetOpenFolderName = Left(Path, Pos - 1)
' Else
' GetOpenFolderName = ""
' End If
End Function
mskippi
ich glaube ich fange noch mal an.
Ich habe ein Verzeichnis mit dem Namen "xyz" , in diesem ist folgenses
abgelegt:
1. mehrere Unterordner ("Ordner1", "Ordner2", "Ordner..n"), darin
verschiedene Dateien.
2. eine Excelliste. Diese soll die Dateien in den Unterordner
auflisten.
Als Spaltenüberschrift für die Excelliste soll definiert werden:
Spalte A: "No." -- lfd. Nr. für die Anzahl der gelisteten Dateien)
Spalte B: "Path" -- Der Pfad in der die Datei abgelegt ist [Beispiel
-- "\Ordner1", ..."\Ordner..n"]
Spalte C: "Filename" -- Der Dateiname mit Dateiendung
Spalte D: "Link" -- ein Text "Link" über den die Datei aus Spalte C
aufgerufen wird
Spalte E: "Comments" -- manueler Eintrag eines Kommentar, nachdem die
Liste erzeugt wurde.
(automatisch aus dateiinfo
'comments' wäre schön, klappt aber irgentwie nicht)
Mit dem kopieren meinte ich das Verzeichnis "xyz". Ich möchte das
gesamte Verzeichnis inkl. Exceldatei und Unterordner an andere
Personen weitergeben. Diese sollen dann kein Problem haben, die
einzelnen Dateien aus der Excelliste heraus aufrufen zu können. Daher
möchte ich keinen absoluten Pfadangaben mit Angabe des Laufwerks auf
meinem Rechner
Unten nochmal der überarbeitet Code.
Die Auswahl des Verzeichnis, welches gelistet werden soll klappt jetzt
prima.
Die gewünschten Daten werden in den richtigen Spalten eingetragen.
Die Liste wird zum Schluß durchnummeriert.
Leider habe ich immer noch die absoluten Pfadanben (bis zum
Laufwerksbuchstaben). ich möchte aber nur die Unterordner angegenen
haben.
Und die Verlinkung zum Aufruf der Dateien fehlt mir noch.
Es wird so langsam!
Gruß
Markus
Option Explicit
Public Sub Dateienlisten()
'*****************************************
'** Auswahl des auszuwertenden Ordner **
'*****************************************
Dim PFAD As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
PFAD = .SelectedItems(1)
If Right(PFAD, 1) <> "\" Then PFAD = PFAD & "\"
Else
PFAD = ""
End If
End With
If PFAD = "" Then MsgBox ("Kein Ordner gewählt!") 'Else MsgBox
PFAD
'*****************************************
'** Tabelle vorbereiten **
'*****************************************
Cells.Select
Selection.ClearContents
With ThisWorkbook.Worksheets("Tabelle1")
.[A1].Select
.[A1:E1] = Array("No.", "Path", "Filename", "Link", "Comment")
'"comment" muss von Hand eingetragen werden!!
'********************************************************
'** Sub list_files aufrufen , Spaltenbreite anpassen **
'********************************************************
Call list_files(.[A2:E2], CreateObject( _
"Scripting.FileSystemObject").GetFolder(PFAD))
.[A:E].EntireColumn.AutoFit
End With
'****************************************************
'** Dateien nach Unterordner/Dateiname sortieren **
'****************************************************
'????????????????????????
'????????????????????????
'**********************************************
' nicht leere Zeilen nummerieren **
'**********************************************
Dim rng As Range, a As Variant, t As Long, z As Long
Dim amax As Long, bmax As Long
amax = Range("C65536").End(xlUp).Row
bmax = Range("B65536").End(xlUp).Row
If amax < bmax Then amax = bmax
Set rng = Range("b2:c" & amax)
a = Range("a2:a" & amax)
For t = 1 To UBound(a)
If rng.Cells(t, 1).Font.Bold Then a(t, 1) = "x"
If rng(t, 1) = "" And rng(t, 2) = "" Then a(t, 1) = "x"
Next
For t = 1 To UBound(a)
If a(t, 1) = "x" Then
a(t, 1) = ""
Else
z = z + 1
a(t, 1) = z
End If
Next
Range("a2").Resize(UBound(a), 1) = a
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
On Error GoTo ende
Application.ScreenUpdating = False
For Each file In ordner.Files
r(2) = ordner.Path
r(3) = file.Name
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
Andreas Killer
> Unten nochmal der �berarbeitet Code.
Okay, wenn Du es so m�chtest, Dein Wunsch sei mir Befehl. :-))
Andreas.
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:E1] = Array("No.", "Path", "Filename", "Link", "Comment")
'********************************************************
'** Sub list_files aufrufen , Spaltenbreite anpassen **
'********************************************************
Call list_files([A2:E2], CreateObject("Scripting" & _
".FileSystemObject").GetFolder(Pfad))
'****************************************************
'** 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("D" & 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
On Error GoTo ende
Application.ScreenUpdating = False
For Each file In ordner.Files
r(2) = Replace(ordner.Path, ThisWorkbook.Path & "\", "")
mskippi
>
> Okay, wenn Du es so möchtest, Dein Wunsch sei mir Befehl. :-))
>
> Andreas.
>
Hallo Andreas,
danke für Deine Hilfe, das klappt ja prima!!!!!
So hatte ich es mir vorgestellt.
Jetzt werde ich nur noch ein wenig an den Zellenformaten schrauben,
denn etwas Farbe darf schon noch mit in Spiel kommen und fertig.
Und die Sache mit dem automatischen Auslesen der der Dateiinfo
"Kommentar" nehme ich mir irgendwann später vor.
Danke und Gruß
Markus
Peter Schleif
>
> Und die Sache mit dem automatischen Auslesen der der Dateiinfo
> "Kommentar" nehme ich mir irgendwann später vor.
Vielleicht ist "GetDetailsOf" eine Ansatzpunkt:
http://www.google.de/search?q=GetDetailsOf+VBA+comments
Habe mich aber nicht damit beschäftigt.
Peter
mskippi
Hallo Peter,
danke für den Tipp. Das scheint zu funktionieren.
Ich habe mal einen Code aus dem Link ausgeführt, die Kommentare wurden
mit den Dateien gelistet.
Da werde ich mal schauen, ob ich diese Funktion irgendwie auf meinen
Code umsetzten kann.
Gruß
Markus
Peter Schleif
>
> Ich habe mal einen Code aus dem Link ausgeführt, die Kommentare wurden
> mit den Dateien gelistet.
> Da werde ich mal schauen, ob ich diese Funktion irgendwie auf meinen
> Code umsetzten kann.
Viel Erfolg dabei. Kannst Du evtl. kurz die Lösung posten?! Ist
vielleicht hilfreich, falls mal jemand eine ähnliche Aufgabenstellung
hat und nach einer Lösung sucht.
Peter
mskippi
So, es ist geschafft.
Der Code ist (zumindest vorläufig) vervollständigt. siehe unten
Er erzeugt nun nach Auswahl eines Verzeichnisses eine Liste, die über
folgende Informationen verfügt.
Pfad, Dateiname, Änderungsdatum, und Kommentar (aus Dateiinfo)
Zusätzlich wird die Liste fortlaufend nummeriert, nach Namen sortiert
und die Dateien können per „Link“ aus Excel aufgerufen werden.
Dank am ALLE, die direkt oder indirekt mitgewirkt haben.
Gruß Markus
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",
"Comment")
[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)
Peter Schleif
>
> Der Code ist (zumindest vorläufig) vervollständigt. siehe unten
> Er erzeugt nun nach Auswahl eines Verzeichnisses eine Liste, die über
> folgende Informationen verfügt.
> Pfad, Dateiname, Änderungsdatum, und Kommentar (aus Dateiinfo)
> Zusätzlich wird die Liste fortlaufend nummeriert, nach Namen sortiert
> und die Dateien können per „Link“ aus Excel aufgerufen werden.
Super!!! Funktioniert bei mir out-of-the-box.
Vielleicht kann man ScreenUpdating noch in die Haupt-Routine hochziehen.
Dann flackert es etwas weniger. Weiß gar nicht mehr, warum ich das
damals in die Rekursion gepackt habe. tss, tss, tss.
Sonst alles bestens. Werde ich mir aufheben. Vielen Dank.
Peter
mskippi
> Peter
Habe ich so eben ausprobiert. Gefällt mir nicht ganz so gut.
Legt man das ScreenUpdating in die Hauptroutine, sieht man nicht mehr,
dass etwas passiert. Das kann bei längeren Listen schon etwas
irritieren. Aber jedem so, wie er es mag, oder?
Gruß
Markus
Peter Schleif
>
> Legt man das ScreenUpdating in die Hauptroutine, sieht man nicht mehr,
> dass etwas passiert. Das kann bei längeren Listen schon etwas
> irritieren.
Dann würde ich die User bei längeren Listen aber zwischendurch
informieren. In der StatusBar oder einem nicht-modalen Mini-Formular:
Application.StatusBar = file.Name
Besser: Vorab die Files zählen und in list_files() runter zählen.
Peter
Dim lFileCounter As Long 'auf Modul-Ebene
Public Sub Dateienlisten()
'...
lFileCounter = count_files(CreateObject("Scripting" & _
".FileSystemObject").GetFolder(Pfad))
'...
End Sub
Function count_files(ordner As Variant) As Long
Dim subordner As Variant
count_files = ordner.Files.Count
For Each subordner In ordner.SubFolders
If (subordner.Attributes And 4) = 0 Then '/System-Ordner/
count_files = count_files + count_files(subordner)
End If
Next
End Function
Sub list_files(r As Range, ordner As Variant)
'...
For Each file In ordner.Files
lFileCounter = lFileCounter - 1
Application.StatusBar = lFileCounter & " - " & file.Name
'...
Next
'...
End Sub