MartyConnelly
martyconnelly at shaw.ca
Thu Jul 24 13:14:25 CDT 2003
Charlotte Foust wrote:
>I'm using A2002 and ADO 2.5. For some reason I have a mental block
>today. I want to set the Jet User Roster recordset returned from
>OpenSchema to a form's recordset, but I get an error 7965, The object
>you entered is not a valid Recordset property I used an adUseServer
>cursor on the connection, and in fact I get the recordset back. What am
>I missing here? I *never* do this, so I'm rusty.
>
>Charlotte Foust
>
>
>
It actually returns an Array with strings containing multiple Nulls
among other things
so I use getstring to parse them out, then I return a long string to
place in textbox. I suppose you could place this in temp recordset.
' Constants
'
'The Microsoft Jet Provider defines a number of GUIDs
'and property values that are for provider-specific features
'and properties. Because they are provider-specific values,
'ADO does not expose them in enumeration values or constants
' for further info see:
' http://www.microsoft.com/data/ado/adotechinfo/dao2ado_9.htm
' http://msdn.microsoft.com/library/techart/daotoadoupdate_topic10.htm
'Remember to set reference to MS ADO 2.5 or higher
' Jet OLE DB Provider Defined Schema Rowsets Constants
Global Const JET_SCHEMA_USERROSTER = _
"{947bb102-5d43-11d1-bdbf-00c04fb92675}"
Global Const JET_SCHEMA_ISAMSTATS = _
"{8703b612-5d43-11d1-bdbf-00c04fb92675}"
' Microsoft Jet OLEDB:Database Locking Mode property values
Global Const JET_DATABASELOCKMODE_PAGE = 0
Global Const JET_DATABASELOCKMODE_ROW = 1
'Remember to set reference to MS ADO 2.5 or higher
' sample calls
'
'ADOUserRoster "C:\Program Files\Microsoft
Office\Office\Samples\Northwind.mdb"
'ADOUserStats "C:\Program Files\Microsoft
Office\Office\Samples\Northwind.mdb"
Function ADOUserRoster(strAccessMDBName As String) As String
Dim cnn As New ADODB.Connection
Dim rst As ADODB.Recordset
Dim varGetString As Variant
' Use before ADO calls
On Error GoTo AdoError
' Open the connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strAccessMDBName & ";"
' Open the user roster schema rowset
Set rst = cnn.OpenSchema(adSchemaProviderSpecific, , _
JET_SCHEMA_USERROSTER)
' Print the results to the debug window
'Column Description
'COMPUTER_NAME The name of the workstation as specified using
' the Network icon in Control Panel.
'LOGIN_NAME The name of the user used to log on to the database
' if the database has been secured; otherwise,
' the default value will be Admin.
'CONNECTED True, if there is a corresponding user lock
' in the .ldb file.
'SUSPECTED_STATE True, if the user has left the database
' in a suspect state; otherwise, Null.
Debug.Print "Computer Name Login Name" & _
" Connected Suspected State"
'can only grab once
'Use all defaults: get all rows, TAB column delimiter, CARRIAGE RETURN
'row delimiter, empty-string null delimiter
varGetString = rst.GetString(adClipString, , ",", ";", "?")
'computer name string has a couple of nulls in so remove
Dim ab() As Byte
Dim i As Long
Dim lstrlen As Long
lstrlen = (Len(varGetString) - 1) * 2
ab = varGetString
For i = 0 To lstrlen Step 2
Debug.Print Chr(ab(i)); ab(i); i
If ab(i) = 0 Then
ab(i) = 32
End If
Next i
' Format string for text box
varGetString = ab
varGetString = Replace(varGetString, ",0,", ", False ,")
varGetString = Replace(varGetString, ",-1,", ", True ,")
varGetString = Replace(varGetString, ",?", ", ?? ,")
varGetString = Replace(varGetString, ",", " ")
varGetString = Replace(varGetString, ";", vbCrLf)
Debug.Print varGetString
ADOUserRoster = "Computer Name Login Name" & _
" Connected Suspected State" & vbCrLf & _
varGetString
cnn.Close
Set cnn = Nothing
Exit Function
' ADO Error/Exception Handler
AdoError:
Dim ErrNumber As Long
Dim ErrSource As String
Dim ErrDescription As String
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AdoErrorExpanded cnn
cnn.Close
Set cnn = Nothing
'where Cnn is Connection Object
End Function
Sub AdoErrorExpanded(Conn1 As ADODB.Connection)
' ADO Error/Exception Handler Expanded
Dim Errs1 As ADODB.Errors
Dim errLoop As ADODB.Error
Dim i As Long
Dim strMsgErr As String
i = 1
On Error Resume Next
' For any error condition, show results in debug
' Enumerate Errors collection and display properties
' of each Error object.
Set Errs1 = Conn1.Errors
For Each errLoop In Errs1
With errLoop
Debug.Print " Error #" & i & ":"
Debug.Print " ADO Error #" & .Number
Debug.Print " Description " & .Description
Debug.Print " Source " & .Source
Debug.Print " HelpFile " & .HelpFile
Debug.Print " HelpContext " & .HelpContext
Debug.Print " NativeError " & .NativeError
Debug.Print " SQLState " & .SQLState
strMsgErr = " Error #" & i & ":"
strMsgErr = strMsgErr & vbCrLf & " ADO Error #" & .Number
strMsgErr = strMsgErr & vbCrLf & " Description " & .Description
strMsgErr = strMsgErr & vbCrLf & " Source " & .Source
strMsgErr = strMsgErr & vbCrLf & " HelpFile " & .HelpFile
strMsgErr = strMsgErr & vbCrLf & " HelpContext " & .HelpContext
strMsgErr = strMsgErr & vbCrLf & " NativeError " & .NativeError
strMsgErr = strMsgErr & vbCrLf & " SQLState " & .SQLState
MsgBox strMsgErr
i = i + 1
End With
Next
With Conn1
Debug.Print "ADO Version: " & .Version & vbCrLf & _
"DBMS Name: " & .Properties("DBMS Name") & vbCrLf & _
"DBMS Version: " & .Properties("DBMS Version") & vbCrLf & _
"OLE DB Version: " & .Properties("OLE DB Version") & vbCrLf & _
"Provider Name: " & .Properties("Provider Name") & vbCrLf & _
"Provider Version: " & .Properties("Provider Version") & vbCrLf
Debug.Print "ADO Version: " & .Version & vbCrLf & _
"DBMS Name: " & .Properties("DBMS Name") & vbCrLf & _
"DBMS Version: " & .Properties("DBMS Version") & vbCrLf & _
"OLE DB Version: " & .Properties("OLE DB Version") & vbCrLf & _
"Provider Name: " & .Properties("Provider Name") & vbCrLf & _
"Provider Version: " & .Properties("Provider Version") & vbCrLf & _
"Driver Name: " & .Properties("Driver Name") & vbCrLf & _
"Driver Version: " & .Properties("Driver Version") & vbCrLf & _
"Driver ODBC Version: " & .Properties("Driver ODBC Version")
End With
End Sub