Makro klappt nicht.Warum?
09.08.2006 15:35:36
Psus82
ich habe jetzt ein Makro welches die Dateinamen in einem Ordner "C:\Testumgebung" ausliest (z.B. abc.pdf,abd.pdf) und mit Werten in einem von mir makierten Bereich vom Excelsheet (immer nur eine Spalte aber unterschiedliche Zeilenanzahl)(z.b abc,abd,add,aff) vergleicht und wenn sie gleich sind einen Hyperlink erstellen soll.
Nur leider klappt es nicht.
Und ich habe keine Ahnung warum.
Kann mal einer über den Quellcode schauen?
Wäre echt nett.
Hier mein Code(Größer Zeichen durch "Größer" ersetzt da ich sonst nicht posten hätte können):
Private Sub Hyperlinks()
On Error GoTo Ende
Dim LA As String
Dim LSA As String
Dim LTTD As String
Dim Row As Integer
Dim Area As Range
Dim i As Integer
Dim i2 As Integer
Dim Counter As Integer
Dim Compare1 As String
Dim Compare2 As String
With Application.FileSearch
.LookIn = "C:\Testumgebung"
.SearchSubFolders = True
.Filename = "*.pdf"
.Execute
Sheets("TF106B").Select
Counter = Len("C:\Testumgebung") + 2
Set Area = Application.InputBox(prompt:="Bereich auswählen", Default:=Selection.Address, Type:=8)
Row = ActiveCell.Row - 1
If Area.Count "Größer" 0 Then
For i2 = 1 To Area.Count
If .FoundFiles.Count "Größer" 0 Then
For i = 1 To .FoundFiles.Count
LA = .FoundFiles(i)
LSA = "Sheet1!B" & Row + i2
LTTD = Mid(.FoundFiles(i), Counter, Len(.FoundFiles(i)) - 4)
Compare1 = Mid(.FoundFiles(i), Counter)
Compare2 = Area(i2) & ".pdf"
If Compare2 = Compare Then ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=LA, SubAddress:=LSA, TextToDisplay:=LTTD
Next i
End If
Next i2
End If
End With
Ende:
End Sub