Dateien eines Ordners als Hyperlink

Forumthread: Dateien eines Ordners als Hyperlink

13.09.2003 22:39:53

Ralf

Hallo,
wie kann ich die Excel Dateien eines Ordners als Hyperlink in einem Tabellenblatt angezeigt bekommen.Hab es schon mit FileSearch und anschließend
mit
For Each C In Selection
C.Hyperlinks.Add C
versucht, die Dateien werden auch als Hyperlink angezeigt bloß er funktioniert nicht bzw.der pfad im Hyperlink passt nicht.

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Dateien eines Ordners als Hyperlink

13.09.2003 22:42:22

Sorry doppelt
AW: Dateien eines Ordners als Hyperlink

14.09.2003 10:25:36

GraFri
AW: Dateien eines Ordners als Hyperlink

14.09.2003 16:12:28

Ralf

AW: Dateien eines Ordners als Hyperlink

13.09.2003 22:42:22

Sorry doppelt

o.t.

AW: Dateien eines Ordners als Hyperlink

14.09.2003 10:25:36

GraFri

Hallo

Hab ich mal irgendwo gefunden.

Option Explicit

Sub DateienAuflisten()
    Dim FileArray(), Tb
    Dim VzPfad As String, DatTyp As String, DatName As String
    Dim n As Integer, TBIndex As Integer, i As Integer
     On Error GoTo Fehler
     If ActiveWorkbook.ProtectStructure = False Then
Verzeichnispfad:
      VzPfad = InputBox("Geben Sie den Verzeichnispfad an." & _
               vbCrLf & vbCrLf & _
               "( Eingabeform: [Laufwerk] :\ [Verzeichnis] )", _
               "Dateiliste erstellen", "F:\Eigene Dateien\Excel")
   If VzPfad = "" Then Exit Sub
      DatTyp = InputBox("Geben Sie den Dateityp an." & _
               vbCrLf & vbCrLf & _
               "( Eingabeform: [Datei-Extension], ' * ' für " & _
               "alle Dateien )", "Dateiliste erstellen", "xls")
   If DatTyp = "" Then Exit Sub
   If Dir(VzPfad, vbDirectory) = "" Then
      MsgBox "Verzeichnispfad ist falsch !  Das Verzeichnis" & _
              vbCrLf & "' " & VzPfad & " '" & _
              vbCrLf & "existiert nicht !", _
              vbExclamation, "Fehlermeldung"
GoTo Verzeichnispfad
  End If
      Application.ScreenUpdating = False
      ChDrive Left(VzPfad, 1)
      ChDir VzPfad
      DatName = Dir("*." & DatTyp)
   Do While DatName <> ""
      n = n + 1
ReDim Preserve FileArray(1 To n)
      FileArray(n) = DatName
      DatName = Dir()
Loop
   If n = 0 Then
      MsgBox "Es wurden keine Dateien dieses Typs gefunden !", _
             vbInformation, "Meldung"
Exit Sub
  End If
      TBIndex = 1
  For Each Tb In Sheets
   If InStr(1, Tb.Name, "Dateiliste") Then
      TBIndex = TBIndex + 1
  End If
Next Tb
With Worksheets.Add
      .Move Before:=Worksheets(1)
      .Name = "Dateiliste (" & TBIndex & ")"
      .Cells.Font.Name = "Tahoma"
      .Cells.Font.Size = 8
      .Cells(5, 2).Font.Bold = True
      .Cells(5, 4).Font.Bold = True
      .Range(Cells(2, 2), Cells(3, 2)).Font.Bold = True
      .Range(Cells(7, 2), Cells(n + 6, 2)).Font.Bold = True
      .Range(Cells(7, 2), Cells(n + 6, 2)).HorizontalAlignment _
       = xlRight
      .Cells(5, 2).HorizontalAlignment = xlCenter
      .Columns(1).ColumnWidth = 2
      .Columns(2).ColumnWidth = 5
      .Columns(3).ColumnWidth = 1
  End With
With ActiveWindow
      .DisplayGridlines = False
      .DisplayHeadings = False
  End With
  For i = 1 To n
With ActiveSheet
      .Cells(2, 2).Value = "Dateiliste von Verzeichnis: " & _
       UCase(VzPfad)
      .Cells(3, 2).Value = "Dateityp: *." & UCase(DatTyp)
      .Cells(5, 2).Value = "- Nr. -"
      .Cells(5, 4).Value = "Datei (Name.Typ)"
      .Cells(i + 6, 2).Value = i & ")"
  End With
   If InStr(1, FileArray(i), ".XL", 1) Then
With ActiveSheet
      .Hyperlinks.Add Anchor:=.Cells(i + 6, 4), Address:= _
       UCase(VzPfad & "\" & FileArray(i))
      .Cells(i + 6, 4).Value = UCase(FileArray(i))
      .Cells(i + 6, 4).Font.Name = "Tahoma"
      .Cells(i + 6, 4).Font.Size = 8
  End With
Else
      ActiveSheet.Cells(i + 6, 4).Value = UCase(FileArray(i))
  End If
Next i
With ActiveSheet
      .Columns(4).EntireColumn.AutoFit
      .Range(Cells(7, 4), Cells(i + 6, 4)).Sort _
      Key1:=ActiveSheet.Range("D7"), Order1:=xlAscending
  End With
      Application.ScreenUpdating = True
      MsgBox "Es wurden " & n & " Dateien dieses Typs" & _
             vbCrLf & "gefunden, aufgelistet und sortiert.", _
             vbInformation, "Meldung"
Else
      MsgBox "Die aktive Arbeitsmappe ist geschuetzt !" & _
             vbCrLf & "Routine kann nicht ausgefuehrt werden.", _
             vbExclamation, "Fehlermeldung"
  End If
Exit Sub
Fehler:
Application.ScreenUpdating = True
MsgBox "Fehler !  Diese Routine wurde beendet." & _
       vbCrLf & Error, _
       vbExclamation, "Fehlermeldung"
End Sub

Code eingefügt mit Syntaxhighlighter 2.4

mfg, GraFri

Beliebteste Forumthreads (12 Monate)

Dateien eines Ordners als Hyperlink

Forumthread: Dateien eines Ordners als Hyperlink

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread