AW: PDF Dateien
13.09.2013 14:58:48
fcs
Hallo Andreas,
für eine Dateiliste in Excel kannst du das folgende Makro verwenden.
Makro in einem allgemeinen Modul im VBA-Editor einfügen.
Leeres Tabellenblatt in Datei anlegen/aktivieren und Makro Starten.
Gruß
Franz
Option Explicit
'Dateiliste erstellen
Public lCount As Long
Public arrFiles() As String
Sub ListFiles(ByVal sFolder As String, _
Optional ByVal sFilter As String = "*.*", _
Optional ByVal bSubfolders As Boolean = False, _
Optional ByVal bFullname As Boolean = False, _
Optional ByVal bCreated As Boolean = False, _
Optional ByVal bSize As Boolean = False)
Dim objFSO As Object
Dim objFolder As Object, objSubfolder As Object
Dim objFile As Object
Dim ws As Worksheet
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object associated with the directory
If sFolder = "" Then GoTo Beenden
Set objFolder = objFSO.GetFolder(sFolder)
'Loop through the Files collection
For Each objFile In objFolder.Files
If LCase(objFile.Name) Like LCase(sFilter) Then
lCount = lCount + 1
ReDim Preserve arrFiles(1 To 3, 1 To lCount)
If bFullname = True Then
arrFiles(1, lCount) = objFile.Path
Else
arrFiles(1, lCount) = objFile.Name
End If
arrFiles(2, lCount) = objFile.Size
arrFiles(3, lCount) = objFile.DateLastModified
End If
Next
If bSubfolders = True Then
For Each objSubfolder In objFolder.subFolders
Call ListFiles(sFolder:=objSubfolder.Path, sFilter:=sFilter, _
bSubfolders:=bSubfolders, _
bFullname:=bFullname, _
bCreated:=bCreated, bSize:=bSize)
Next
End If
Beenden:
'Clean up!
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
End Sub
Sub ListePDF_erstellen()
'Dateiliste des Verzeichnisse erstellen
Dim wks As Worksheet, varVerzeichnis, i%
Dim objFS As Object
Dim strDatei, verzOld As String, lngZeile As Integer
Dim Zeile As Long, lFile As Long
Dim varSplit
Set wks = ActiveSheet
verzOld = VBA.CurDir & "\*.*"
'Verzeichnis auswählen
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Dateiliste - Bitte gewünschtes Verzeichnis auswählen"
.InitialFileName = verzOld
.InitialView = msoFileDialogViewList
If .Show = -1 Then
varVerzeichnis = .SelectedItems(1)
Else
GoTo Beenden
End If
End With
'Dateiliste erstellen
lCount = 0
Erase arrFiles
Call ListFiles(sFolder:=varVerzeichnis, _
sFilter:="*.pdf")
'Dateiinformationen in Tabellenblatt eintragen
With wks
Application.ScreenUpdating = False
.Cells(1, 1).Value = "Pfad:"
.Cells(1, 2).Value = varVerzeichnis
.Cells(2, 1).Value = "Dateiname"
.Cells(2, 2).Value = "Nr"
.Cells(2, 3).Value = "STL/DRW"
.Cells(2, 4).Value = "Nr2"
.Cells(2, 5).Value = "Rest"
'Altdaten löschen
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
If Zeile >= 3 Then
.Range(.Rows(3), .Rows(Zeile)).ClearContents
End If
.Range(.Columns(1), .Columns(5)).NumberFormat = "@" 'alle Spalten als Text formatieren
If lCount > 0 Then
Zeile = 2
For lFile = 1 To lCount
Zeile = Zeile + 1
.Cells(Zeile, 1) = arrFiles(1, lFile) '(Pfad) Name
varSplit = VBA.Split(arrFiles(1, lFile), "_")
.Cells(Zeile, 2).Resize(1, UBound(varSplit) + 1) = varSplit
Next
Else
MsgBox "Keine Dateien im Verzeichnis gefunden!"
End If
.Columns.AutoFit
ActiveWindow.ScrollRow = 1
Range("A3").Select
ActiveWindow.FreezePanes = True
'Dateiliste sortieren
If Zeile >= 4 Then
With .Range(.Rows(2), .Rows(Zeile))
.Sort Key1:=.Cells(1, 3), Order1:=xlAscending, _
Key2:=.Cells(1, 1), Order2:=xlAscending, Header:=True
End With
End If
Application.ScreenUpdating = True
End With
lCount = 0
Erase arrFiles
Beenden:
End Sub