AW: Ordner & Dateinamen Baumartig auflisten
Ramses
Hallo
Probier das mal aus
Option Explicit
Sub List_All_Files_and_create_hyperlinks()
Dim foundArr As Variant
Dim filePfad As String, fileExt As String, fileAge As Integer
Dim result As Long, i As Long
'Zu durchsuchender Pfad
'----------------------
'Anpassen
filePfad = "C:\drivers\"
'------------------------
'Dateierweiterung
'Allenfalls für spezifische Dateien anpassen
fileExt = "*"
'------------------------
result = FileSearchINFO(foundArr, filePfad, "*." & fileExt, True)
Cells(1, 1) = "Pfad"
If result <> 0 Then
For i = 0 To UBound(foundArr)
Cells(i + 2, 1) = foundArr(i)
Next
End If
'Spalte für Hyperlinks erstellen
Columns("A:A").Insert Shift:=xlToRight
'Hyperlinks erstellen
For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
Cells(i, 1).FormulaLocal = "=hyperlink(""" & Cells(i, 2).Text & """;""" & Right(Cells(i, 2).Text, Len(Cells(i, 2).Text) - InStrRev(Cells(i, 2).Text, "\", -1)) & """)"
Next i
'Aufteilen der gefundenen Dateien
Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, otherChar:="\"
'Hyperlinks ans ende setzen
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
Cells(i, Cells(i, Columns.Count).End(xlToLeft).Column).Formula = Cells(i, 1).Formula
Next i
'spalten bereinigen
Columns(1).Delete
End Sub
Private Function FileSearchINFO(ByRef Files As Variant, ByVal InitialPath As String, Optional ByVal FileName As String = "*", _
Optional ByVal SubFolders As Boolean = False) As Long
'by J.Ehrensberger
'# PARAMETERINFO:
'# Files: Datenfeld zur Ausgabe der Suchergebnisse
'# InitialPath: String der das zu durchsuchende Verzeichnis angibt
'# FileName: String der den gesuchten Dateityp oder Dateinamen enthält (Optional, Standard="*.*" findet alle Dateien)
'# Beispiele: "*.txt" - Findet alle Textdateien
'# "*name*" - Findet alle Dateien mit "name" im Dateinamen
'# "*.avi;*.mpg" - Findet .avi und .mpg Dateien (Dateitypen mit ; trennen)
'# SubFolders: Boolean gibt an, ob Unterordner durchsucht werden sollen (Optional, Standard=False)
Dim fobjFSO As Object, ffsoFolder As Object, ffsoSubFolder As Object, ffsoFile As Object
Dim intC As Integer, varFiles As Variant
Set fobjFSO = CreateObject("Scripting.FileSystemObject")
Set ffsoFolder = fobjFSO.GetFolder(InitialPath)
On Error Resume Next
If InStr(1, FileName, ";") > 0 Then
varFiles = Split(FileName, ";")
Else
ReDim varFiles(0)
varFiles(0) = FileName
End If
For Each ffsoFile In ffsoFolder.Files
If Not ffsoFile Is Nothing Then
For intC = 0 To UBound(varFiles)
If LCase(fobjFSO.GetFileName(ffsoFile)) Like LCase(varFiles(intC)) Then
If IsArray(Files) Then
ReDim Preserve Files(UBound(Files) + 1)
Else
ReDim Files(0)
End If
Set Files(UBound(Files)) = ffsoFile
End If
Next
End If
Next
If SubFolders = True Then
For Each ffsoSubFolder In ffsoFolder.SubFolders
FileSearchINFO Files, ffsoSubFolder, FileName, SubFolders
Next
End If
If IsArray(Files) Then FileSearchINFO = UBound(Files) + 1
On Error GoTo 0
Set fobjFSO = Nothing
Set ffsoFolder = Nothing
End Function
Das sieht dann in der Tabelle so aus
Tabelle1
| | A | B | C | D | E | F | G |
| 1 | Pfad | | | | | | |
| 2 | C: | DRIVERS | ActiveProtection | 6asa07ww.exe | | | |
| 3 | C: | DRIVERS | ActiveProtection | setup.exe | | | |
| 4 | C: | DRIVERS | ActiveProtection | SWI.XML | | | |
| 5 | C: | DRIVERS | Audio Driver | 7wa109ww.exe | | | |
| 6 | C: | DRIVERS | Audio Driver | IPathVXS.INI | | | |
| 7 | C: | DRIVERS | Audio Driver | Setup.exe | | | |
| 8 | C: | DRIVERS | Audio Driver | SWI.XML | | | |
| 9 | C: | DRIVERS | Audio Driver | SmAudio | SALenApp.ini | | |
| 10 | C: | DRIVERS | Audio Driver | SmAudio | Setup.exe | | |
| 11 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio.ini | | |
| 12 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio | BlueStream.wav | |
| 13 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio | CnxtMusic.WAV | |
| 14 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio | CnxtVoice.WAV | |
| 15 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio | JackA.bmp | |
| 16 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio | JackB.bmp | |
| 17 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio | JackC.bmp | |
| 18 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio | Logo.bmp | |
| 19 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio | RedStream.wav | |
| 20 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio | SmAudio.exe | |
| 21 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio | dll | res0401.dll |
| 22 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio | dll | res0404.dll |
| 23 | C: | DRIVERS | Audio Driver | SmAudio | SmAudio | dll | res0405.dll |
| Formeln der Tabelle |
| Zelle | Formel | | D2 | =HYPERLINK("C:\DRIVERS\ActiveProtection\6asa07ww.exe";"6asa07ww.exe") | | D3 | =HYPERLINK("C:\DRIVERS\ActiveProtection\setup.exe";"setup.exe") | | D4 | =HYPERLINK("C:\DRIVERS\ActiveProtection\SWI.XML";"SWI.XML") | | D5 | =HYPERLINK("C:\DRIVERS\Audio Driver\7wa109ww.exe";"7wa109ww.exe") | | D6 | =HYPERLINK("C:\DRIVERS\Audio Driver\IPathVXS.INI";"IPathVXS.INI") | | D7 | =HYPERLINK("C:\DRIVERS\Audio Driver\Setup.exe";"Setup.exe") | | D8 | =HYPERLINK("C:\DRIVERS\Audio Driver\SWI.XML";"SWI.XML") | | E9 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SALenApp.ini";"SALenApp.ini") | | E10 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\Setup.exe";"Setup.exe") | | E11 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio.ini";"SmAudio.ini") | | F12 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio\BlueStream.wav";"BlueStream.wav") | | F13 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio\CnxtMusic.WAV";"CnxtMusic.WAV") | | F14 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio\CnxtVoice.WAV";"CnxtVoice.WAV") | | F15 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio\JackA.bmp";"JackA.bmp") | | F16 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio\JackB.bmp";"JackB.bmp") | | F17 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio\JackC.bmp";"JackC.bmp") | | F18 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio\Logo.bmp";"Logo.bmp") | | F19 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio\RedStream.wav";"RedStream.wav") | | F20 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio\SmAudio.exe";"SmAudio.exe") | | G21 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio\dll\res0401.dll";"res0401.dll") | | G22 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio\dll\res0404.dll";"res0404.dll") | | G23 | =HYPERLINK("C:\DRIVERS\Audio Driver\SmAudio\SmAudio\dll\res0405.dll";"res0405.dll") |
|
Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Gruss Rainer
