Dim dateien()
Dim ordner()
Option Explicit
Sub DateienLesen()
Dim DateiName As String
Dim quelle As String
Dim i As Long
Dim j As Long
Dim Dateialt As String
Dim zeilealt As Long
Dim Namekurz As String
Dim Blatt As Object
Dim gefunden As Boolean
Dim suchwert As Variant
Dim suche As Variant
Dim test
Dateialt = ThisWorkbook.Name
zeilealt = 1
suchwert = InputBox("Zu suchenden Wert eingeben!", "Suchtexteingabe")
If suchwert = "" Then
MsgBox "Sie haben keinen Wert eingegeben oder Abbrechen angeklickt. Das Program wird beendet.", , "Abbruch Eingaben"
End
End If
ReDim dateien(0)
dateien(0) = 0
quelle = ""
If Right(quelle, 1) = "\" Then quelle = Left(quelle, Len(quelle) - 1)
If Dir(quelle & "\") = "" Then
MsgBox "Der Pfad wurde nicht gefunden!"
End
End If
ReDim ordner(1)
ordner(0) = 0
ordner(1) = quelle
While UBound(ordner) <> ordner(0)
Call txtsuchen
Wend
If dateien(0) = 0 Then
MsgBox "Keine .txt Dateien gefunden!"
Else
For i = 1 To dateien(0)
DateiName = dateien(i)
Namekurz = Right(DateiName, InStr(1, StrReverse(DateiName), "\") - 1)
gefunden = False
Workbooks.Open DateiName, Password:="ABC"
For Each Blatt In Worksheets
suche = Application.WorksheetFunction.CountIf(ActiveSheet.UsedRange, suchwert & "*")
If suche > 0 Then gefunden = True
Next Blatt
Workbooks(Dateialt).Activate
Workbooks(Namekurz).Close savechanges:=False
If gefunden = True Then
ActiveSheet.Hyperlinks.Add anchor:=ActiveSheet.Cells(zeilealt, 1), Address:=DateiName, TextToDisplay:=Namekurz
zeilealt = zeilealt + 2
End If
Next i
End If
End Sub
Function txtsuchen()
Dim suche
Dim i As Long
Dim quelle As String
quelle = ordner(ordner(0) + 1)
ordner(0) = ordner(0) + 1
ChDrive (Left(quelle & "\", 3))
ChDir (quelle)
suche = Dir(quelle & "\*.*", vbDirectory)
Do Until suche = ""
If (GetAttr(quelle & "\" & suche) = 16) Then
If Left(suche, 1) <> "." Then
ReDim Preserve ordner(UBound(ordner) + 1)
ordner(UBound(ordner)) = quelle & "\" & suche
End If
Else
If Right(suche, 4) = ".xls" Then
If (Len(suche) <> Len(Replace(suche, "_Planung", "")) Or Len(suche) <> Len(Replace(suche, "_planung", "")) Or Len(suche) <> Len(Replace(suche, "_PLANUNG", ""))) And Len(suche) <> Len(Replace(suche, "2016", "")) Then
dateien(0) = dateien(0) + 1
ReDim Preserve dateien(dateien(0))
dateien(dateien(0)) = quelle & "\" & suche
End If
End If
End If
suche = Dir()
Loop
End Function