Hallo ihr freundlichen Helfer,

ich arbeite beruflich mit einer Datenbank (Access),die na ja, etwas veraltet ist und teilweise nicht mehr funktioniert. In der Datenbank gibt es eine "Schaltfläche" mit der sich eine Excel-Datei (mit Markos, also .xlsm) öffnen soll.

In VBA sieht das folgender Maßen aus:

Private Sub Steuerelement_Kostenplan_Click()

    Dim objXL As Object
    Dim DB As Database
    Dim Rst As Recordset
    Dim strSQL, strSave As String

On Error GoTo Err_Kostenplan_Click
    
    Set DB = CurrentDb()
    strSQL = "SELECT Parameter.Wert FROM Parameter " & _
        "WHERE (((Parameter.Bezeichnung) = 'Ordner_Kostenpläne')) " & _
        "WITH OWNERACCESS OPTION;"
        
    Set Rst = DB.OpenRecordset(strSQL, dbOpenDynaset)
        
    Set objXL = CreateObject("Excel.Application")
    
    With objXL.Application
        On Error Resume Next
        .Workbooks.Open Rst.Fields("Wert") & "\" & [Projektnr] & [Phase] & ".xlsm"
        If Err.Number = 1004 Then
           If MsgBox("Der Kostenplan '" & Rst.Fields("Wert") & "\" & [Projektnr] & [Phase] & ".xlsm" & _
            "' konnte nicht gefunden werden. Soll ein neuer Kostenplan angelegt werden?", 36) = 6 Then
                On Error GoTo Err_Kostenplan_Click
                strSave = Rst.Fields("Wert") & "\" & [Projektnr] & [Phase] & ".xlsm"
                strSQL = "SELECT Parameter.Wert FROM Parameter " & _
                    "WHERE (((Parameter.Bezeichnung) = 'Muster_Kostenpläne')) " & _
                    "WITH OWNERACCESS OPTION;"
                Set Rst = DB.OpenRecordset(strSQL, dbOpenDynaset)
                With objXL.Application
                    On Error GoTo Muster_fehlt
                    .Workbooks.Open Rst.Fields("Wert")
                    On Error Resume Next
                    .activeworkbook.saveas strSave
                    .Visible = True
                    objXL.UserControl = True
                    On Error GoTo Err_Kostenplan_Click
                End With
            Else: GoTo Exit_Kostenplan_Click
            End If
        End If
        .Visible = True
        objXL.UserControl = True
    End With

Exit_Kostenplan_Click:
    Set objXL = Nothing
    Exit Sub

Muster_fehlt:
    Dummy = MsgBox("Die Mustertabelle '" & Rst.Fields("Wert") & "' konnte nicht gefunden werden!", 16)
    Resume Exit_Kostenplan_Click
    
Err_Kostenplan_Click:
    MsgBox Err.Description
    Resume Exit_Kostenplan_Click
    
End Sub

Ich habe es insoweit geändert, dass es auf die .xlsm-Dateien zugreift. Allerdings geht das "Warnfenster" mit dem Text, dass kein Kostenplan gefunden wurde, nur auf bzw. ich sehe es nur, wenn ich über den Task-Manager gehe. Die Musterdatei der Kostenpläne findet er auch nicht, weil sich die Dateiendung auch bei diesem in .xlsm geändert hat.

Er greift auch leider nur auf die Kostenpläne, die schon angelegt sind, zurück, die im Ordner "Kostenpläne" sind. Da das aber so viele sind, haben wir die in Unterordner verschoben (z. B. 1000 - 1099) und auf diese greift er bei seiner Suche leider nicht zurück.

Kann mir jemand von euch helfen? Ich würde mich sehr freuen.

Liebe Grüße
Sandra