Automatisierungsproblem beim Recordset
18.11.2020 09:22:48
Sanselm
ich habe eine Funktion die bei allen Kollegen läuft, bloss bei einem einzigen funktioniert diese Funktion nicht. Er hat die gleiche Excel und Windows Version, was die ganze Geschichte in meinen Augen recht komisch macht. Ebenfalls habe ich auch schon die Verweise überprüft und hier ist mir nichts ungewöhnliches aufgefallen.
Bei folgendem Code bricht das Programm, beim Prüfen der Recordset Verbindung (letzte if Abfrage) mit einem Automatisierungsfehler ab.
Function check_Authority() As Boolean
Dim lib As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
On Error Resume Next
check_Authority = False
sSYS = ThisWorkbook.Sheets("Config").Cells(5, 3).value
lib = "CS" & sEnvironment & "DTA" & sLanguage
sSql = "SELECT PW001 FROM " & lib & ".APCPW WHERE PW007 = '" + UCase(sUser) + "'"
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
With cn
.ConnectionString = "DSN=" & sODBC & ";UID=" & sUser & ";PWD=" & sPWD
.Properties("Prompt") = adPromptCompleteRequired
.Open
End With
If cn.State adStateOpen Then
MsgBox "Verbindung zu " & sODBC & " fehlgeschlagen!", vbCritical + vbApplicationModal, " _
Verbindung zu " & sODBC
Exit Function
End If
rs.Open sSql, cn, adOpenDynamic, adLockReadOnly
If rs.State adStateOpen Or (rs.EOF = True And rs.BOF = True) Then
MsgBox "Fuer keine Firma berechtigt", vbCritical + vbApplicationModal, "Datenuebertragung"
Exit Function
End If
PS: Habe den Code nur auf die nötigen Funktionen runtergebrochen.
Grüße,
Sanselm