BITTE HELFEN! Dateien auflisten

Informationen und Beispiele zu den hier genannten Dialog-Elementen:


Excel-Version: 97
nach unten

Betrifft: BITTE HELFEN! Dateien auflisten
von: Mike
Geschrieben am: 29.04.2002 - 15:58:42

Wie kann ich in der aktiven Tabelle in Spalte A Hyperlinks zu allen Excel-Dateien eines bestimmten Verzeichnisses einschließlich aller Subordner erstellen?
Mit nachfolgendem Skript bekomme ich nur den jeweils aktuellen Ordner.
'StandardModule: modMain

Sub DateiBehandlung()
Dim arrFiles As Variant
Dim intCounter As Integer
Application.ScreenUpdating = False
arrFiles = FileArray("c:\excel\support", "*.xls")
For intCounter = 1 To UBound(arrFiles)
With ThisWorkbook.Worksheets(1)
.Cells(intCounter, 1) = arrFiles(intCounter)
.Hyperlinks.Add Anchor:=.Cells(intCounter, 1), _
Address:="c:\excel\support\" & .Cells(intCounter, 1).Value
End With
Next intCounter
Columns(1).AutoFit
End Sub

Function FileArray(strPath As String, strPattern As String)
Dim arrDateien()
Dim intCounter As Integer
Dim strDatei As String
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strDatei = Dir(strPath & strPattern)
Do While strDatei <> ""
intCounter = intCounter + 1
ReDim Preserve arrDateien(1 To intCounter)
arrDateien(intCounter) = strDatei
strDatei = Dir()
Loop
FileArray = arrDateien
End Function

'ClassModule: Tabelle1

Private Sub CommandButton1_Click()
Call DateiBehandlung
End Sub
nach oben   nach unten

Re: BITTE HELFEN! Dateien auflisten
von: Joachim K
Geschrieben am: 29.04.2002 - 16:10:21

Hallo Mike, mit folgendem Code bekommst Du auch die Unterverzeichnisse: Sub Alle_Auflisten() Dim Datei As FileSearch Dim i As Integer Set Datei = Application.FileSearch On Error Resume Next Dim SuchText, SuchZeichen, Pos0, Pos(1 To 10), AA, BB, CC verz = InputBox("Welches Verzeichnis soll aufgelistet werden ? ", , "K:/CBU_DC") DA = InputBox("welche Dateiart soll aufgelistet werden ? ", , "*.xls") Rows("2:60000").ClearContents Range("A2:A60000").Select With Selection.Font .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Application.Calculation = xlManual With Datei .FileName = DA .LookIn = verz .SearchSubFolders = True If .Execute > 0 Then MsgBox "Es gibt " & .FoundFiles.Count & " Dateien <" & DA & ">" For i = 1 To .FoundFiles.Count 'MsgBox .FoundFiles(i) ', Password:="DeinPasswort" Cells(i + 1, 1).Value = .FoundFiles(i) Next End If End With Application.Calculation = xlCalculationAutomatic For AA = 2 To 10000 SuchText = Cells(AA, 1).Value If SuchText = "" Then Exit Sub SuchZeichen = "\" Pos1 = InStr(1, SuchText, SuchZeichen, 1) For BB = 2 To 10 Pos(BB) = InStr(Pos(BB - 1) + 1, SuchText, SuchZeichen, 1) Next BB For CC = 1 To 10 If Pos(CC) > Pos(CC + 1) Then Pos0 = Pos(CC): Exit For Next CC Application.Cells(AA, 2).Value = Mid(SuchText, Pos0 + 1) Next AA End Sub Gruß Joachim

nach oben   nach unten

Re: BITTE HELFEN! Dateien auflisten
von: Martin Beck
Geschrieben am: 29.04.2002 - 16:11:22

Hallo Mike, versuch's mal hiermit: Gruß Martin Beck

nach oben   nach unten

Joachims Lösung Dateien auflisten
von: Mike
Geschrieben am: 29.04.2002 - 17:14:50

Die Lösung ist nicht schlecht, jetzt fehlt halt nur die Erstellung der Hyperlinks

nach oben   nach unten

Re: Joachims Lösung Dateien auflisten
von: Joachim K
Geschrieben am: 29.04.2002 - 17:53:47

Setzt alle Texte in Spalte A in Hyperlinks um : Sub Hyperlink_einfügen_Liste_Spalte_A() For i = 1 To 30000 V_A = Application.Cells(i, 1).Value If Application.Cells(i, 1).Value = "" Then Exit Sub 'MsgBox Application.Cells(i, 1).Value ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:=V_A Next i End Sub Die Lösung von Martin liefert Dir den Hyperlink, warum nimmst Du nicht den Code ? Gruß Joachim

nach oben   nach unten

1000 Dank zu Joachims Lösung Dateien auflisten
von: Mike
Geschrieben am: 30.04.2002 - 08:15:29

Ich finde die Abfrage, welches Verzeichnis gelistet werden soll einfach besser.

nach oben   nach unten

Dateien auflisten mit Abfrage
von: Joachim K
Geschrieben am: 30.04.2002 - 08:49:38

Hallo Jörg , Martins Lösung mit Abfrage : Sub auslesen() 'Alle Dateien eines Ordners nebst Unterordner auslesen 'und mit Hyperlink versehen. 'Aus leerem Blatt starten. Dim fs As FileSearch Dim intCounter As Integer Dim strFolder As String Dim Verz As String Application.Volatile '--- Abfrage--- Verz = InputBox("Welches Verzeichnis soll aufgelistet werden ? ", , "C:/Daten") strFolder = Verz 'Pfad anpassen" Set fs = Application.FileSearch With fs .LookIn = strFolder .SearchSubFolders = True .FileType = msoFileTypeExcelWorkbooks 'msoFileTypeAllFiles .Execute End With For intCounter = 1 To fs.FoundFiles.Count Cells(intCounter, 1) = fs.FoundFiles(intCounter) ActiveSheet.Hyperlinks.Add Anchor:=Cells(intCounter, 1), Address:=Cells(intCounter, 1).Value Next intCounter End Sub Gruß Joachim

nach oben   nach unten

Re: Wie kann man den Ordner variabel gestalten
von: Rainer Quaas
Geschrieben am: 02.05.2002 - 13:32:35

Hallo Martin,

schöne Lösung von Dir. Aber mit "strFolder" wir ein definierter Pfad abgelegt und ist somit nicht variabel. Der Code müßte für jeden anderen Pfad umgeschrieben werden.

Besteht die Möglichkeit den zu untersuchenden Ordner mit "Application.GetOpenFilename" der Variablen "strFolder" zuzuordnen? Wenn ja, wie müßte der Code dafür lauten?

Gruß Rainer


nach oben   nach unten

Re: Wie kann man den Ordner variabel gestalten
von: Martin Beck
Geschrieben am: 02.05.2002 - 22:50:48

Hallo Rainer,

vielleicht geht es einfacher, aber das sollte es tun:

Gruß
Martin Beck

nach oben   nach unten

Re: Wie kann man den Ordner variabel gestalten
von: Rainer Quaas
Geschrieben am: 03.05.2002 - 16:59:47

Hallo Martin,

danke für den Lösungsvorschlag.

Weiter oben im Forums-Jornal gibt es auf meine Frage eine für mich bessere Lösung -> siehe

https://www.herber.de/forum/archiv/116to120/t117882.htm

Mit Hilfe Deines Codes habe ich das obige Makro am Ende noch ergänzt.

Diese Info habe ich für die anderen Forums-Besucher hinzugefügt, da Du dies ja sicherlich weist.

Gruß Rainer


 nach oben

Beiträge aus den Excel-Beispielen zum Thema "BITTE HELFEN! Dateien auflisten"