Leider sind meine Makro Kenntnisse nicht ausreichen mir selber zu helfen (das Makro ist zum Teil von NEPUMUK erstellt).
Ich habe 2 Probleme mit einem Makro das nach Namen sucht in Dateien, und diese als Hyperlink auflistet!
Public Sub searchHyperlink()
Dim objFileSearch As clsFileSearch
Dim objWB As Workbook, objSh As Worksheet, objThisSH As Worksheet, objFind As Range
Dim lngIndex As Long, lngRow As Long
Dim strPath As String, strName As String
On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
strName = InputBox("Bitte gesuchten Namen eingeben!", "Hyperlinkliste", "?")
If strName CStr(False) And (Len(strName)) Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "T:\05_UP\80_Kunden\Neu\Kunden\" 'Startverzeichnis
.Title = "Hyperlink erstellen - Ordnerwahl"
.ButtonName = "Start..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strPath = .SelectedItems(1)
If Right(strPath, 1) "\" Then strPath = strPath & "\"
End If
End With
If Len(strPath) Then
ActiveSheet.Unprotect Password:="dobro"
Set objThisSH = ThisWorkbook.Sheets("Hyperlink") 'Ausgabeblatt in dieser Datei
objThisSH.Range("A2:A" & Rows.Count).ClearContents
objThisSH.Range("A1") = "Dateien unerledigt für '" & strName & "'"
lngRow = 2
Set objFileSearch = New clsFileSearch
With objFileSearch
.NewSearch = True
.CaseSenstiv = False
.Extension = "*.xls*"
.FolderPath = strPath
.SearchLike = "*APQP*.xls*"
.SubFolders = True
If .Execute(Sort_by_Date_Create, Sort_Order_Descending) > 0 Then
For lngIndex = 1 To .FileCount
'Set objWB = Workbooks.Open(.Files(lngIndex).FI_FullName)
Set objWB = Workbooks.Open(.Files(lngIndex).FI_FullName, ReadOnly:=True)
For Each objSh In objWB.Worksheets
If objSh.Name Like "CL-Phase*" Then
Set objFind = objSh.Range("H:H").Find(What:=strName, Lookat:=xlWhole, _
LookIn:=xlValues, MatchCase:=False, SearchFormat:=False)
If Not objFind Is Nothing Then
If objFind.Offset(0, 4) = "" Or Not IsDate(objFind.Offset(0, 4)) Then
objThisSH.Hyperlinks.Add Anchor:=objThisSH.Cells(lngRow, 1), _
Address:=objWB.FullName, TextToDisplay:=objWB.FullName
objThisSH.Cells(lngRow, 1).Style = "Hyperlink"
lngRow = lngRow + 1
Exit For
End If
End If
End If
Next
objWB.Close False
Next
End If
End With
End If
ActiveSheet.Protect Password:="dobro"
End If
ErrorHandler:
With Application
.ScreenUpdating = True
.EnableEvents = True
.AskToUpdateLinks = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
Set objFileSearch = Nothing
Set objThisSH = Nothing
Set objWB = Nothing
Set objSh = Nothing
Set objFind = Nothing
End Sub
1. Problem wenn eine Datei auf dem Server von einem Kollegen geöffnet ist (die durchsucht werden sollte) macht das Makro gar nicht's, wenn die Dateien geschlossen sind listet es soweit korrekt auf?Ich glaube verstanden zu haben dass er die Dateien virtuell öffnet um nach den Namen zu suchen, und wenn eine Datei geöffnet ist bleibt das Makro stehen .
Hier wäre ich froh, wenn es eine Lösung gäbe, wenn das Makro die Auswertung auch machen würde wenn eine Datei geöffnet ist, da ich sonst fass nie einen günstigen Zeitpunkt finden kann wo alle Dateien geschlossen sind, was müsste man ändern dass das geht?
2. In der Versuchsdatei habe ich ein Problem, wenn ich in der Suche *Burger* eingebe, findet es die Datei nicht (2241-APQP-V1.xlsx) obwohl von der Abfrage her das Datum mehrfach nicht vorhanden ist, wenn ich die Suche mit *PL* mache wird die Datei aufgeführt ich sehe aber keinen Unterschied?
Woran kann das liegen?
Wunsch könnte man noch einbauen, dass er die Dateien nur durchsucht, wenn im Registerblatt Projekt- und QM-Plan in der Zelle I4 ein Datum vorhanden ist.
PS: normal haben die Dateien die durchsucht werden einen Blattschutz, aber ich denke das sollte keinen Einfluss haben, weil es ja teilweise geht?
https://www.herber.de/bbs/user/129112.zip
https://www.herber.de/bbs/user/129113.zip
2 Dateien weil es sonst zu Gross ist!
Für eure Hilfe vielen Dank
Gruss MaBlu