I have a form that I choose from a list of database names and a list
within a textbox comes up with the computer ID number and an associated
(from a table) user name. Is there a way from looking at this code to
tell the network ID name? I hope not to have to write the code with the
"Dev Ashish" API code, which I'm sure is great but I can't figure out
how to implement it in a form like mine. Please look at the below code
and tell if I can modify it to give network ID. I'm using A2000 and
without access security in place.
Thanks!
Option Compare Database
Option Explicit
Private Const ms_UNKNOWN As String = "Unknown User"
Private Function CreateListHeader() As String
Dim strFill As String
strFill = "No.;Computer ID;User Name;Connected?;Suspect State?;"
CreateListHeader = strFill
End Function
Private Sub cboDBName_Change()
Dim strDB As String
Dim strMsg As String
If IsBlank(Me.cboDBName) Then
strMsg = "Unable to perform operation without a valid database
name."
MsgBox strMsg, vbInformation, "Database Name is Blank"
Exit Sub
Else
strDB = Me.cboDBName
ShowUsersInDB (strDB)
End If
End Sub
Private Sub cboDBName_Click()
Dim strDB As String
Dim strMsg As String
strDB = Me.cboDBName
ShowUsersInDB (strDB)
End If
End Sub
Private Sub ShowUsersInDB(ByVal strDB As String)
Dim cnn As New ADODB.Connection
Dim rec As ADODB.Recordset
Dim fld As ADODB.Field
Dim intUser As Integer
Dim intFldCount As Integer
Dim varVal As Variant
Dim strPC As String
Dim strUser As String
Dim strConnected As String
Dim strSuspect As String
Dim strData As String
Dim strInfo As String
'get the db name
strFile = GrabDBPath(strDB)
DoCmd.Hourglass True
'if it gets here - see who is in the database
strData = CreateListHeader
strFile = strFile & strDB & DB_EXT
'open the connection and recordset
cnn.Open JET_PROVIDER & "Data Source=" & strFile & ";"
Set rec = cnn.OpenSchema(Schema:=adSchemaProviderSpecific,
SchemaId:=adhcUsers)
With rec
Debug.Print rec.RecordCount
Do Until .EOF
intUser = intUser + 1
strNo = CStr(intUser) & ";"
intFldCount = 0
For Each fld In .Fields
intFldCount = intFldCount + 1
varVal = fld.Value
Select Case intFldCount
Case 1
strPC = StripNullChar(varVal)
Case 2 'get the user name for the ID
If IsNull(varVal) Then
strUser = ms_UNKNOWN & ";"
Else
strUser = GrabUserName(strPC)
End If
Case 3
strConnected = StripNullChar(varVal)
Case 4 'suspected state
If IsNull(varVal) Then
strSuspect = "False" & ";"
Else
strSuspect = StripNullChar(varVal)
End If
End Select
Next
strData = strData & strNo & strPC & strUser & strConnected
& strSuspect
.MoveNext
Loop
End With
Me.lstUsers.RowSource = strData
rec.Close
Set rec = Nothing
Set fld = Nothing
Set cnn = Nothing
End Sub
Private Function GrabUserName(ByVal strPCID As String) As String
Dim cnn As New ADODB.Connection
Dim cmd As ADODB.Command
Dim rec As ADODB.Recordset
Dim strSQL As String
Dim strUser As String
Set cnn = CurrentProject.Connection
Set cmd = New ADODB.Command
strSQL = "SELECT * FROM tblUserIDs WHERE PCID Like '" &
Left$(strPCID, Len(strPCID) - 1) & "'"
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdText
cmd.CommandText = strSQL
Set rec = cmd.Execute
If Not rec.EOF Then
strUser = rec(1)
Else
strUser = ms_UNKNOWN
End If
rec.Close
cnn.Close
Set cnn = Nothing
End Function
