Angeregt durch das Skript Dir_in_DOC habe ich ein VB-Skript Dir_in_XLS geschrieben:
Der Code muss in einen Texteditor kopiert und dann als VBS-Datei (z.B. Dir_in_XLS.vbs) abgespeichert werden. Dann sollte man eine Verknüpfung auf dem Desktop erzeugen.
Zieht man nun einen Ordner auf die Verknüpfung oder wählt nach Doppelklick einen Ordner aus, wird der Inhalt des Ordners in Excel angezeigt und kann abgespeichert werden.
Neue Version ab 31.07.2007 - siehe unten: Beitrag #19
Code:
' *********************************************************************
' Funktion: Schreibt ein Dateininhaltsverzeichnis des gedroppten
' bzw. ausgewähltene Ordners in eine neue Excel-Tabelle
'
' Erfordert: - Windows Scripting Host 2.0
' - Excel ab Version 97
'
' Vorgehen: - Datei auf dem Desktop ablegen oder
' dort eine Verknüpfung erstellen
'
' Anwendung - Anzuzeigenden Ordner auf die Datei bzw.
' auf die Verknüpfung ziehen oder
' - nach Doppelklick anzuzeigenden Ordner
' auswählen und mit OK bestätigen
'
' Copyright (C) 2006 Harald Maeckler, Düsseldorf
' *********************************************************************
Option Explicit
'Definitionen
Dim AppShell
Dim BrowseDir
Dim Verz
Dim objFS 'FileSystemObject
Dim objFolder 'Ordner
Dim objSubFolder 'Unterordner
Dim objFile 'Dateien
Dim FileAnzahl 'Dateizähler
Dim SubFolderG 'Unterordnergröße
Dim objExcel 'Excel
Dim Zeile 'Zeile
Dim strExt 'Extension einer Datei
'Excel-Konstante
Const xlRight = 4 'Rechtsbündig
Const xlCenter = 3 'Mittig
'******************* VB-Script **************************************
On Error Resume Next
Set objFS = WScript.CreateObject("Scripting.FileSystemObject") 'FileSytemObject
Set objFolder = objFS.GetFolder(WScript.Arguments(0)) 'gedroppter Ordner
If objFolder Is Nothing Then
Set AppShell = CreateObject("Shell.Application") 'Explorer-Aufruf
Set BrowseDir = AppShell.BrowseForFolder(0, "", &H1, 17)
Verz = BrowseDir.ParentFolder.ParseName(BrowseDir.Title).Path
If Err.Number > 0 Then
Pos = InStr(BrowseDir, ":")
Verz = Mid(BrowseDir, Pos - 1, 1) & ":\"
End If
Set objFolder = objFS.GetFolder(Verz)
End If
If objFolder Is Nothing Then 'kein Ordner bekannt
MsgBox "Kein Ordner ausgewählt", vbInformation, Wscript.ScriptName
WScript.Quit
End if
Set objExcel = WScript.CreateObject("Excel.Application") 'Excel-Aufruf
If objExcel Is Nothing then
MsgBox "Excel kann nicht gestartet werden.", vbInformation, Wscript.ScriptName
WScript.Quit
End If
With objExcel
.Workbooks.Add
.Visible = True
.ActiveSheet.Cells(1,1).Value = "Inhalt von " & objFolder.Path 'Ordneranzeige
Zeile = 3
Dim UVv
Dim objNFolder '#### weitere Unter-Unterordner vorhanden -> <+ UV>
For Each objSubFolder In objFolder.SubFolders 'Unterordner-Auflistung
.ActiveSheet.Cells(Zeile,2).Value = objSubFolder.Files.Count & " Dateien"
.ActiveSheet.Cells(Zeile,4).Value = UCase(objSubFolder.Name)
Set objNFolder = objFS.GetFolder(objSubFolder.Path)
if objNFolder.SubFolders.Count > 0 then
.ActiveSheet.Cells(Zeile,5).Value = "+ <Verz>"
UVv = True
else
.ActiveSheet.Cells(Zeile,5).Value = "<Verz>"
end if
.ActiveSheet.Cells(Zeile,6).Value = objSubFolder.Size
.ActiveSheet.Cells(Zeile,7).Value = "Bytes"
.ActiveSheet.Cells(Zeile,9).Value = objSubFolder.DateLastModified
Zeile = Zeile + 1
FileAnzahl = FileAnzahl + objSubFolder.Files.Count 'Dateienanzahl Unterordner
SubFolderG = SubFolderG + objSubfolder.Size 'Größensumme Unterordner
Next
if FileAnzahl > 0 then Zeile = Zeile + 1
.ActiveSheet.Cells(Zeile,2).Value = objFolder.Files.Count & " Dateien"
.ActiveSheet.Cells(Zeile,4).Value = "direkt im Hauptverzeichnis"
.Range("D" + Cstr(Zeile)).Select
.Selection.Font.FontStyle = "Kursiv" 'Schrift Kursiv
.ActiveSheet.Cells(Zeile,6).Value = objFolder.Size - SubFolderG 'Größensumme H.-Verz.
.ActiveSheet.Cells(Zeile,7).Value = "Bytes"
.ActiveSheet.Cells(Zeile,9).Value = objFolder.DateLastModified 'Datum des H.-Verz.
Zeile = Zeile + 1
FileAnzahl = FileAnzahl + objFolder.Files.Count 'Dateienanzahl gesamt
For Each objFile In objFolder.Files 'Dateien-Auflistung
.ActiveSheet.Cells(Zeile,4).Value = objFile.Name
strExt = objFS.GetExtensionName(objFile.Name) 'Datei-Extension ermitteln
.ActiveSheet.Cells(Zeile,5).Value = UCase(strExt)
.ActiveSheet.Cells(Zeile,6).Value = objFile.Size
.ActiveSheet.Cells(Zeile,7).Value = "Bytes"
.ActiveSheet.Cells(Zeile,9).Value = objFile.DateLastModified
Zeile = Zeile + 1
Next
Zeile = Zeile + 1
.ActiveSheet.Cells(Zeile,1).Value = "Zusammenfassung:" 'Zusammenfassung
.Range("A" + Cstr(Zeile)).Select
.Selection.Font.FontStyle = "Fett" 'Schrift Fett
Zeile = Zeile + 1
.ActiveSheet.Cells(Zeile,2).Value = FileAnzahl & " Dateien"
.ActiveSheet.Cells(Zeile,6).Value = objFolder.Size
.ActiveSheet.Cells(Zeile,7).Value = "Bytes"
'Formatierung
.Range("A1").Select
.Selection.Font.FontStyle = "Fett" 'Schrift Fett
.Selection.ColumnWidth = 1 'Spaltenbreite 1 setzen
.Range("C1").Select
.Selection.ColumnWidth = 1 'Spaltenbreite 1 setzen
.Range("E1").Select
.Selection.ColumnWidth = 5 'Spaltenbreite 5 setzen
.Range("H1").Select
.Selection.ColumnWidth = 1 'Spaltenbreite 1 setzen
.Columns("B:I").Select
.Selection.Columns.AutoFit 'Optimierung der Spaltenbreite
.Columns("F:F").Select
.Selection.NumberFormat = "#,##0" 'Formatierung der Größen
.Columns("B:B").Select
.Selection.HorizontalAlignment = xlRight 'Rechtsbündige Anordnung
.Columns("E:E").Select
.Selection.HorizontalAlignment = xlRight 'Rechtsbündige Anordnung
.Range("A1").Activate
End With
if UVv then MsgBox "'+ <Verz>' bedeutet, dass im Unterordner weitere Unterverzeichnisse vorhanden sind." _
& vbCr & "Die darin enthaltenen Dateien werden nicht mitgezählt, aber die Dateigrößen werden mit aufaddiert" _
,,"Hinweis"
'**************************************************************************************************************
Zieht man nun einen Ordner auf die Verknüpfung oder wählt nach Doppelklick einen Ordner aus, wird der Inhalt des Ordners in Excel angezeigt und kann abgespeichert werden.
Neue Version ab 31.07.2007 - siehe unten: Beitrag #19
Zuletzt bearbeitet: