AW: PDF Aus Ordner ,aus bestimmten Unterordner auslese
26.03.2015 07:26:27
Hajo_Zi
Hallo Heinz,
mal nur auf Deinen Fall angepast.
Private Sub SearchInFolder(ByVal Folderspec As String)
' auslesen aufrufen mit Ordnername
Dim FSO As New FileSystemObject
Dim SearchFolder As Folder
Dim FD As Folder, FI As File
Dim EachFil As Files, EachFold As Folders
Dim LoI As Long ' Laufvariable zum schreiben der Ordner
Set SearchFolder = FSO.GetFolder(Folderspec)
Set EachFil = SearchFolder.Files ' Dateien in der jeweiligen Root
If Chk_Unter Then ' Unterverzeichnis ausgewählt
' für Unterverzeichnis
Set EachFold = SearchFolder.SubFolders ' Unterordner in der Root
DoEvents ' andere Befehle ausführen
' Unterordner des Verzeichnisses feststellen und in Datei schreiben
For Each FD In EachFold
' Ordner schreiben
If Chk_Datei_schreiben = False And Chk_Hyperlink = False Then
Cells(LoI + 1, 1) = FD ' Ordner eintragen
LoI = LoI + 1
End If
SearchInFolder CStr(FD) ' Funktion rekursiv aufrufen weitere _
Unterverzeichnisse
Next FD
' ***** es sind alle Verzeichnisse aufgelistet
End If
' Dateien auslesen
If Chk_Datei_schreiben Or Chk_Hyperlink Then ' Dateiname schreiben
For Each FI In EachFil ' Schleife über alle Dateien
' Ergänzung Hajo
' Dateityp feststellen
If UCase(Right(FI.Name, Len(FI.Name) - InStrRev(FI.Name, "."))) = UCase(StTyp) Or _
StTyp = "" Or StTyp = "*" Then
' Darstellungsart
If Chk_Hyperlink = True Then ' Hyperlink ausgewählt
If UCase(Mid(FI.Path, InStrRev(FI.Path, "\") - 3, 4)) = "\PA\" Then
If Opt_Hyperlink_Datei Then
' Hyperlink nur Dateiname
ActiveSheet.Hyperlinks.Add Anchor:=Cells(Loletzte, 3), _
Address:=FI.Path, TextToDisplay:=FI.Name
Else
' Hyperlink Pfad und Dateiname
ActiveSheet.Hyperlinks.Add Anchor:=Cells(Loletzte, 3), _
Address:=FI.Path, TextToDisplay:=FI.Path
End If
Cells(Loletzte, 1) = FI.Path
End If
End If
Loletzte = Loletzte + 1 ' Zeilenzähler um 1 erhöhen
Cmd_Start.Caption = Loletzte ' Programmfortschritt anzeigen
End If
DoEvents
Next FI
If StTyp = "*" And Chk_Datei = True Then
With Cells(Loletzte - 1, 6)
.Formula = "=SUM(D" & LoJ & ":D" & Loletzte - 1 & ")"
.NumberFormat = "#,##0"
End With
End If
Else
' werden nur Verzeichnisse geschrieben beginnt die Liste in Zeile 1, keine Überschrift
Cells(1, 1).Font.Bold = False
End If
Set EachFil = Nothing
Set EachFold = Nothing
Set FSO = Nothing
End Sub
Gruß Hajo