Kode virker ikke i windows 10

Jeg følgende kode : virker i windows 7, men ikke i windows 10
siger at den ikke kan finde kartoteker?

Sub Kunde()
kundenr = InputBox("indtast kundenr")
If kundenr = "" Or Not IsNumeric(kundenr) Then
ActiveDocument.Unprotect
Application.ScreenUpdating = False
Selection.GoTo What:=wdGoToBookmark, Name:="kr"
ActiveWindow.ActivePane.VerticalPercentScrolled = 0
    ActiveDocument.Protect Password:="", NoReset:=False, Type:= _
        wdAllowOnlyFormFields
         
Else

Application.ScreenUpdating = False
    Dim objConn As ADODB.Connection
    Dim objRs As ADODB.Recordset
    Dim strConnString As String
    Dim strSQL As String
   
    Set objConn = New ADODB.Connection
    Set objRs = New ADODB.Recordset
   
   
    FilogSti = Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\SharePoint\Kunder - bilag mv. - Dokumenter\Kartoteker.MDb"

    If Dir(FilogSti) = "" Then ' tjekker om databasen er der
        MsgBox "Filen """ & FilogSti & """ eksisterer ikke"
        Exit Sub
    End If

strConnString = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & FilogSti
    objConn.Open strConnString