AW: Auslesen von Dateien
21.01.2004 19:35:03
Ramses
Hallo
probier mal das.
Damit wird in der aktiven Mappe in der Tabelle1 in Spalte A die gefundene Mappe mit einem Hyperlink aufgelistet ( zum leichteren öffnen :-) und in Spalte B die darin enthaltenen Tabellen
Sub Create_Hyperlink_List_in_Table()
Dim i As Long, totFiles As Long, rowCounter As Long
Dim geffile As String, dname As String
Dim Suchpfad As String, Suchbegriff As String, Dateiform As String
Dim wbMain As Workbook, wbMSheet As Worksheet, strSheet As Worksheet
Dim oldStatus As Variant
Set wbMain = ActiveWorkbook
Set wbMSheet = wbMain.Worksheets("Tabelle1")
rowCounter = 1
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls")
If Dateiform = "" Then Exit Sub
Application.ScreenUpdating = True
oldStatus = Application.StatusBar
With Application.FileSearch
.LookIn = Suchpfad
.SearchSubFolders = True 'Durchsucht alle Unterordner oder =False
.Filename = Dateiform
If .Execute() > 0 Then
totFiles = .FoundFiles.Count
Application.StatusBar = "Total " & totFiles & " gefunden"
For i = 1 To .FoundFiles.Count
geffile = .FoundFiles(i)
Workbooks.Open (geffile), False
wbMSheet.Cells(rowCounter, 1).Hyperlinks.Add Anchor:=wbMSheet.Cells(rowCounter, 1), Address:=geffile, TextToDisplay:=geffile
For Each strSheet In ActiveWorkbook.Worksheets
wbMSheet.Cells(rowCounter, 2) = strSheet.Name
rowCounter = rowCounter + 1
Next
ActiveWorkbook.Close False
Next i
End If
End With
Application.StatusBar = oldStatus
Application.ScreenUpdating = True
End Sub
Gruss Rainer