Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
116to120
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
116to120
116to120
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

BITTE HELFEN! Dateien auflisten

BITTE HELFEN! Dateien auflisten
29.04.2002 15:58:42
Mike
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

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: BITTE HELFEN! Dateien auflisten
29.04.2002 16:10:21
Joachim K
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
Anzeige
Re: BITTE HELFEN! Dateien auflisten
29.04.2002 16:11:22
Martin Beck
Hallo Mike, versuch's mal hiermit: Gruß Martin Beck
Joachims Lösung Dateien auflisten
29.04.2002 17:14:50
Mike
Die Lösung ist nicht schlecht, jetzt fehlt halt nur die Erstellung der Hyperlinks
Re: Joachims Lösung Dateien auflisten
29.04.2002 17:53:47
Joachim K
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
1000 Dank zu Joachims Lösung Dateien auflisten
30.04.2002 08:15:29
Mike
Ich finde die Abfrage, welches Verzeichnis gelistet werden soll einfach besser.
Anzeige
Dateien auflisten mit Abfrage
30.04.2002 08:49:38
Joachim K
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
Anzeige
Re: Wie kann man den Ordner variabel gestalten
02.05.2002 13:32:35
Rainer Quaas
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

Re: Wie kann man den Ordner variabel gestalten
02.05.2002 22:50:48
Martin Beck
Hallo Rainer,

vielleicht geht es einfacher, aber das sollte es tun:

Gruß
Martin Beck

Re: Wie kann man den Ordner variabel gestalten
03.05.2002 16:59:47
Rainer Quaas
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


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige