Fehler bei Zugriff per Script auf externe Domäne

Function fnGetLastLogon(xDomaene As String, intTyp As DOMAnmeldeTyp, Optional xTAGE As Integer = 90)

    Dim ado                                  As Object
    Dim adoCmd                               As Object
    Dim objList                              As Object
    Dim rst                                  As DAO.Recordset2

    Dim lastWeek                             As Date
    Dim lastWeekValue                        As String
    Dim strFilter                            As String
    Dim arrDom()                             As String
    Dim strPWD                               As String
    Dim xDATE                                As Date
    Dim xObject                              As String

    On Error GoTo Err_Function_fnGetLastLogon

    Dim strModulName                         As String
    Dim varErrLine                           As Variant
    strModulName = "mdlADSI.fnGetLastLogon"  
    DoCmd.Hourglass True
    Select Case intTyp
        Case DOMAnmeldeTyp.DOM_COMPUTER
            xObject = "computer"  
        Case DOMAnmeldeTyp.DOM_USER
            xObject = "person"  
        Case Else
            FormatMsgBox "Fehler@Unbekannter Anmeldetyp (nur Benutzer oder Computer).@", vbExclamation  
            Exit Function
    End Select

    arrDom = Split(xDomaene, ".")  
    If Not UBound(arrDom) = 1 Then
        FormatMsgBox "Fehler@Unbekannte Domäne (nur dom1.local oder dom2.local).@", vbExclamation  
        Exit Function
    End If

    Select Case arrDom(0)
        Case "dom1"  
            strPWD = "xxxxx"  
        Case "dom2"  
            strPWD = "xxxxx"  
        Case Else
            FormatMsgBox "Fehler@Unbekannte Domäne (nur dom1.local oder dom2.local).@", vbExclamation  
            Exit Function
    End Select

    CurrentDb.Execute "DELETE FROM tbl_AD_LastLogon", dbFailOnError + dbSeeChanges  
    'Datum+Zeit von vor einer Woche ermitteln  
    lastWeek = DateAdd("d", xTAGE * -1, Now)  

    'Zeigt den Integer Wert des betreffenden Datums+Uhrzeit...  
    lastWeekValue = DateToLargeIntegerString(lastWeek)

    'Nun eine Liste aller Benutzer ausgeben lassen, die sich seit den vergangenen x-Tagen nicht angemeldet haben:  
    strFilter = "(&(objectCategory=" & xObject & ")(lastLogon<=" & lastWeekValue & "))"  

    'Suche Ausführen!  
    Set ado = CreateObject("ADODB.Connection")        'Neue ADO Connection erzeugen  
    ado.PROVIDER = "ADSDSOObject"                     'Die ADSI-Schnittstelle verwenden  
    ado.Properties("User ID") = "administrator@" & xDomaene    'Credentials angeben - wenn sie diese zwei Zeilen weglassen, ...  
    ado.Properties("Password") = strPWD               '... werden die aktuellen Anmeldedaten verwendet  
    ado.Properties("Encrypt Password") = True  
    ado.Open "ADS-Search"                             'Beliebigen Namen für die Connection vergeben  

    Set adoCmd = CreateObject("ADODB.Command")        'Neues ADO-Kommando erzeugen  
    adoCmd.ActiveConnection = ado                     'Zuordnung zur bestehenden ADO-Connection  
    adoCmd.Properties("Page Size") = 10000            'Parameter für Paged Result Suche auf 1000 setzen (=AD Standard)  
    adoCmd.Properties("Cache Results") = True  
    adoCmd.CommandText = "<LDAP://dc=" & arrDom(0) & ",dc=" & arrDom(1) & ">;" & strFilter & ";distinguishedName,name,lastLogonTimestamp,lastLogon,userAccountControl;subtree"  
    Set rst = CurrentDb.OpenRecordset("tbl_AD_LastLogon")  

    Set objList = adoCmd.Execute                      'Suche durchführen  
    While Not objList.EOF
        rst.AddNew
        rst("Pfad").Value = objList.Fields("distinguishedName").Value  
        rst("COMP_NAME").Value = objList.Fields("name").Value  
        xDATE = LargeIntegerToDate(objList.Fields("lastLogon").Value)  
        If Not xDATE = #1/1/1601# Then
            rst("LAST_LOGON").Value = xDATE  
        End If
        rst("AKTIV").Value = fnAccountIsActive(fnGetUserAccountControl(objList.Fields("userAccountControl")))  
        rst.Update
        objList.MoveNext
    Wend                                              'zum nächsten gefundenen Objekt  
    
    rst.Close

ExitHere:
    On Error Resume Next
    DoCmd.Hourglass False
    Set rst = Nothing
    Set objList = Nothing
    Set adoCmd = Nothing
    Set ado = Nothing
    Exit Function