Auflistung von speziellen Dateien in Unterordnern
10.08.2017 07:35:10
speziellen
Ich bin auf dem Gebiet der VBA Programmierung ein totaler Laie, dennoch macht es die heutige Zeit im Berufsleben notwendig, ab und an "besondere" Anforderungen zu erfüllen, die über Formeln hinaus gehen. Deshalb hoffe ich auf Eure Hilfe.
Ich habe einen Code durch copy, paste erfolgreich eingesetzt. Und diesen um 2 Codezeilen erweitert. Das klappt alles bisher wunderbar, (siehe nachfolgenden Code)Jedoch schaffe ich es nicht nur die Dateien welche mit "120_" beginnen aus den Ordnern/ Unterordnern einzufügen. Die Dateiendung wäre zudem .pdf
Alle Dateien auszulesen ist bei der Menge zu aufwendig/bzw. dauert zu lange. Ich hoffe Ihr könnt mir helfen. Super wäre wenn Ihr den neuen Code im gesamten posten könntet. Weil ich eventuelle Schwierigkeiten haben könnte, einzelne Schnipsel richtig einzubauen :)
Das ist der bisherige Code:
Option Explicit
Option Compare Text
Const sRootPath As String = "S:\0_GA_digital\99_FVK\Lacroix_M"
Private lRowCounter As Long
Private oSheet As Object
'Start der Routine: Call MWDateienMitUnterordnernAuslesen
Public Sub Lacroix()
Set oSheet = Sheets("Lacroix")
oSheet.Activate
oSheet.Cells(1, 1).Select
Call CreateHeadLinesAndFormat
lRowCounter = 2
Call MWReadSubFolder(sRootPath)
Set oSheet = Nothing
End Sub
Private Sub CreateHeadLinesAndFormat()
Dim i As Long
oSheet.Cells(1, 1) = "Pfad"
oSheet.Cells(1, 2) = "Dateiname"
oSheet.Cells(1, 3) = "Erstelldatum"
oSheet.Columns(1).ColumnWidth = 40
oSheet.Columns(2).ColumnWidth = 40
oSheet.Columns(3).ColumnWidth = 40
For i = 1 To 3
With oSheet
.Cells(1, i).Interior.ColorIndex = 11
.Cells(1, i).Font.Color = vbWhite
.Cells(1, i).Font.Bold = True
End With
Next i
End Sub
Private Sub MWReadSubFolder(ByVal sPath As String)
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.getfolder(sPath)
With oSheet
For Each oSubFolder In oFolder.subfolders
'Alle Dateien auflisten
For Each oFile In oSubFolder.Files
.Cells(lRowCounter, 1) = oSubFolder.Path
.Cells(lRowCounter, 2) = oFile.Name
.Cells(lRowCounter, 3) = oFile.DateCreated
lRowCounter = lRowCounter + 1
Next oFile
'Alle Unterverzeichnisse verarbeiten (rekursiv)
Call MWReadSubFolder(oSubFolder.Path)
Next oSubFolder
End With
Set oFSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
Set oSubFolder = Nothing
End Sub
