Hallo zusammen,
leider habe ich ein Problem mit u.g. Makro.
Das Makro liest in Sp_A einen Teilstring aus und sucht mir das entsprechende Excel-Dokument in allen Unterordnen und öffnet es.
Das Makro funktioniert einwandfrei.
Beispiel:
Zelle A1= 10111; anklicken und Makro mit Button starten.
Excel-Dokument: 10111_Das ist aber eine schöne Datei.xlsx, öffnet sich.
Nun muss ich auf ein Server-Laufwerk wechseln und bekomme eine Fehlermeldung.
Fehlermeldung: Laufzeitfehler 52; Dateiname oder -nummer falsch.
If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then 'Fehlermeldung
'Const FOLDER_PATH As String = "P:\01_Unterordner\02_Unterordner\usw\" 'das ist der alte Ordner
Const FOLDER_PATH As String = "\\server\Projects\01_Unterordner\02_Unterordner \usw\" 'das ist der neue Ordner
Kann mir bitte jemand helfen dieses Problem zu lösen ?
Ich habe verschiedene Lösungen probiert, bekomme das aber mit meinen VBA-Kenntnissen nicht hin.
Wäre nett wenn mich jemand unterstützen könnte.
Mit freundlichen Grüßen
Manfred
Option Explicit
Sub Aenderung_suche()
'Const FOLDER_PATH As String = "P:\01_Aenderungsantraege\" 'das ist der alte Ordner
Const FOLDER_PATH As String = "\\server\Projects\01_Aenderungsantraege\" 'das ist der neue UNC Pfad Ordner
Dim astrFolders() As String, strFilename As String, strSearch As String
Dim ialngFolders As Long
strSearch = ActiveCell.Value
astrFolders = GetFolders(FOLDER_PATH)
For ialngFolders = LBound(astrFolders) To UBound(astrFolders)
strFilename = Dir$(astrFolders(ialngFolders) & strSearch & "*.xls*") 'Der Dateiname suchen
If strFilename > vbNullString Then Exit For
Next
If strFilename > vbNullString Then
Call ThisWorkbook.FollowHyperlink(astrFolders(ialngFolders) & strFilename)
Else
Call MsgBox("Sowas.... Nummer wurde ( noch ) nicht vergeben !!", vbExclamation, "Hinweis")
End If
End Sub
Private Function GetFolders(ByVal pvstrPath As String) As String()
Dim astrFolders() As String
Dim strFolder As String, strPath As String
Dim ialngIndex1 As Long, ialngIndex2 As Long
ReDim Preserve astrFolders(ialngIndex1)
astrFolders(ialngIndex1) = pvstrPath
ialngIndex1 = 1
ialngIndex2 = 1
strPath = pvstrPath
Do
strFolder = Dir$(PathName:=strPath & "*", Attributes:=vbDirectory)
Do Until strFolder = vbNullString
If strFolder > "." And strFolder > ".." Then
If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then 'Fehlermeldung
ReDim Preserve astrFolders(0 To ialngIndex1)
astrFolders(ialngIndex1) = strPath & strFolder & "\"
ialngIndex1 = ialngIndex1 + 1
End If
End If
strFolder = Dir$
Loop
If ialngIndex1 = ialngIndex2 Then Exit Do
strPath = astrFolders(ialngIndex2)
ialngIndex2 = ialngIndex2 + 1
Loop
GetFolders = astrFolders
End Function