Moin,

versuch mal folgendes:

Option Explicit
Dim vRet As Variant
Dim mFso As Object
'Const Fehlermeldungen
Const m_FEHLERLAENGE As String = "Fehler: Es wird eine Gesamtlänge von 14 Zeichen erwartet."
Const m_CHR45_FEHLT As String = "Fehler: Es wird ein ""-"" an Position 6 erwartet."
Const m_CHR77_FEHLT As String = "Fehler: Es wird ein ""M"" an Position 11 erwartet."
Const m_CH32_FEHLT As String = "Fehler: Es wird ein  LEERZEICHEN an Position 10 erwartet."
Const m_ISNUMERIC As String = "Fehler: Es werden Zahlen an Positionen wie in diesem Beispiel erwarten." & vbNewLine & vbNewLine & "12102-027 M118"

Const m_sPfad As String = "G:\DATEN\Herstellberichte\" '<----anpassen
Const m_FileExtension As String = ".XLSM" '<---- Dateityp anpassen und in Großbuchstaben angeben
  
Dim lCalc As Long
Dim lEvent As Long
Dim lStatusbar As Long
Dim lScreen As Long
  
Sub main()
  
    On Error GoTo FinishErr
    '*** Inputbox den gesuchten Dateinamen zu erhalten
    vRet = InputBox("Nach welchem File soll gesucht werden?", "Dateinamenabfrage")
    '*** ***
    vRet = checkEingabe(vRet)
    '*** ***
    If Len(vRet) <> 14 Then
        MsgBox vRet & vbNewLine & vbNewLine & "Aktion wird abgebrochen.", vbCritical + vbInformation + vbOKOnly, "Autor informiert:"
        Exit Sub
    End If
       
    '*** speed up
    Call TurnOffFunctionality
    '*** Ordner durchsuchen
    Set mFso = CreateObject("Scripting.FileSystemObject")
    Call OrdnerDurchsuchen(mFso.GetFolder(m_sPfad))
          
FinishErr:
If Err.Number <> 0 Then
    MsgBox Err.Number & vbCrLf & Err.Description
 End If
   
    '*** Standard speed
    Call TurnOnFunctionality
  
Set mFso = Nothing
End Sub
  
Sub OrdnerDurchsuchen(ByRef oFolder As Object)
    Dim oSubFldr As Object
    Dim oFile As Object
    '*** Unterordner durchsuchen
    For Each oSubFldr In oFolder.SubFolders
        Call OrdnerDurchsuchen(oSubFldr)
    Next
    '*** Dateien in den Unterordner
    For Each oFile In oFolder.Files
        '*** Wenn Dateintyp stimmt
        If UCase(Right(oFile.Name, 5)) = m_FileExtension Then
            '*** Wenn Inhalt der Inputbox mit Datei übereinstimmt
            If UCase(oFile.Name) = UCase(vRet & m_FileExtension) Then
                '*** dann öffne das File
                Dim wkb As Excel.Workbook
                Set wkb = Application.Workbooks.Add(oFile.Path)
            End If
        End If
    Next
    '*** Objektreferenzen entlassen
    Set oSubFldr = Nothing
    Set oFile = Nothing
    Set wkb = Nothing
End Sub
  
Public Sub TurnOffFunctionality()
    With Application
        lCalc = .Calculation: .Calculation = xlCalculationManual
        lStatusbar = .DisplayStatusBar: .DisplayStatusBar = False
        lEvent = .EnableEvents: .EnableEvents = False
        lScreen = .ScreenUpdating: .ScreenUpdating = False
    End With
End Sub
Public Sub TurnOnFunctionality()
    With Application
        .Calculation = lCalc
        .DisplayStatusBar = lStatusbar
        .EnableEvents = lEvent
        .ScreenUpdating = lScreen
    End With
End Sub
 
Function checkEingabe(ByRef vRet As Variant) As Variant
      
    Dim s As String
    s = vRet
    
    '(Länge = 14)
    If Not Len(s) = 14 Then
        s = m_FEHLERLAENGE
    '(- vorhanden an Position 6)
    ElseIf Not Mid(s, 6, 1) = Chr(45) Then
        s = m_CHR45_FEHLT
    '(Leerzeichen an Position 10 vorhanden)
    ElseIf Not Mid(s, 10, 1) = Chr(32) Then
        s = m_CH32_FEHLT
    '("M" an Position 11 vorhanden)
    ElseIf Not Mid(s, 11, 1) = Chr(77) Then
        s = m_CHR77_FEHLT
    '(Zahlen links/rechts "-") & (Zahlen rechts "M")
    ElseIf Not IsNumeric((Split(Split(s, Chr(32))(0), Chr(45))(0))) _
       And Not IsNumeric((Split(Split(s, Chr(32))(0), Chr(45))(1))) _
       And Not IsNumeric((Split(Split(s, Chr(32))(1), Chr(77))(1))) Then
        s = m_ISNUMERIC
    End If
    'retVal
    checkEingabe = s
End Function