Re: Verzeichnis und Hyperlinks
31.07.2002 08:44:12
Joachim K
Hallo Werner,probiere mal folgendes:
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
'MsgBox Pos0
'MsgBox Mid(SuchText, Pos0 + 1)
Application.Cells(AA, 2).Value = Mid(SuchText, Pos0 + 1)
Next AA
End Sub
++++++++++++++++++++++++++++++++++++++++++++
Sub Hyperlink_einfügen_Liste_Spalte_A()
For i = 2 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
Gruß Joachim