471,573 Members | 1,717 Online
Bytes | Software Development & Data Engineering Community
Post +

Home Posts Topics Members FAQ

Join Bytes to post your question to a community of 471,573 software developers and data experts.

Classic "Who is logged-on" problem...

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

Apr 24 '06 #1
10 2962
I use this code.
Private Declare Function apiGetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function fOSMachineName() As String
'Returns the computername
Dim lngLen As Long, lngX As Long
Dim strCompName As String

lngLen = 16
strCompName = String$(lngLen, 0)
lngX = apiGetComputerName(strCompName, lngLen)
If lngX <> 0 Then
fOSMachineName = Left$(strCompName, lngLen)
Else
fOSMachineName = ""
End If
End Function

If you put =fOSMachineName() in the control source of a unbound text
box, it should give you what you want. I also use this code to return
the user name. Same thing, put =GetNTUser() in the control source of
an unbound text box.

Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function GetNTUser() As String
Dim strUserName As String
'Create a buffer
strUserName = String(100, Chr$(0))
'Get user name
GetUserName strUserName, 100
'Strip the rest of the buffer
strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
GetNTUser = strUserName
End Function

Parasyke wrote:
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


Apr 25 '06 #2
I use this code.
Private Declare Function apiGetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function fOSMachineName() As String
'Returns the computername
Dim lngLen As Long, lngX As Long
Dim strCompName As String

lngLen = 16
strCompName = String$(lngLen, 0)
lngX = apiGetComputerName(strCompName, lngLen)
If lngX <> 0 Then
fOSMachineName = Left$(strCompName, lngLen)
Else
fOSMachineName = ""
End If
End Function

If you put =fOSMachineName() in the control source of a unbound text
box, it should give you what you want. I also use this code to return
the user name. Same thing, put =GetNTUser() in the control source of
an unbound text box.

Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function GetNTUser() As String
Dim strUserName As String
'Create a buffer
strUserName = String(100, Chr$(0))
'Get user name
GetUserName strUserName, 100
'Strip the rest of the buffer
strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
GetNTUser = strUserName
End Function

Parasyke wrote:
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


Apr 25 '06 #3
Sorry, should have included this. It does away with API calls, although
you will have to have a reference to Windows Script Host Object Model

Public Function GetUserName() As String
Dim wshNet As Object
Set wshNet = CreateObject("WScript.Network")
GetUserName = wshNet.username
Set wshNet = Nothing
End Function

Apr 25 '06 #4
Thanks, but I need a little more coaching... so does the below clue you
into the error? (the database name appears in the combobox but the
pesky #Name? appears in the textbox. (BTW I'll have several users to be
listed in the textbox and need it to be in a column type style).
THANKS!

I have a form created without binding to anything.

I created a combobox named cboDBName with its binding being SELECT
[tblDatabases].[DBName] FROM tblDatabases;
placed in the RowSource property.

I created a textbox named txtGetUsers with its binding being
=fOSMachineName()
placed in the ControlSource property.
I pasted this into the code for the form (I deleted some comments and
lines to simplify):

Option Compare Database
Option Explicit
Private Declare Function apiGetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function fOSMachineName() As String

Dim lngLen As Long, lngX As Long
Dim strCompName As String
lngLen = 16
strCompName = String$(lngLen, 0)
lngX = apiGetComputerName(strCompName, lngLen)
If lngX <> 0 Then
fOSMachineName = Left$(strCompName, lngLen)
Else
fOSMachineName = ""
End If
End Function

Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function GetNTUser() As String
Dim strUserName As String
strUserName = String(100, Chr$(0))
GetUserName strUserName, 100
strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
GetNTUser = strUserName
End Function

e.cboDBName

Apr 25 '06 #5
Try this link: http://www.mvps.org/access/modules/mdl0055.htm
it has a small access app that looks at the ldb file and will tell you
all of the users that are logged into mdb that you reference.
really neat and small, and the code for the form can be imported into
any app that you want or run standalone out of this app.
It has all the code you need.....

Apr 25 '06 #6
This seems better. Thanks! Much cleaner code. Is there a way to change
the database name textbox to a combobox and have it do a lookup of an
existing table of the databases and their respective paths?
Again.. Thanks!

Apr 26 '06 #7
That is what I did when I implemented it.

I created a table with the full path and db name and in my case I added
a combo box above the existing txtbox. And then in the afterupdate
event of the combo had it load the txt box with the table name. And
then as part of that same code I had it execute the code that is
executed when you push the button to get the information.

Ron

Apr 26 '06 #8
How do I get the combobox to load the chosen value into the textbox?
I tried in the afterupdate the line:

Private Sub cboDBname_AfterUpdate()
Me!txtDBPath = Me!cboDBname
End Sub

But this didn't populate the textbox.

Any clues?

Thanks!

Apr 26 '06 #9
Nevermind the above, I figured that much out but should I write my code
like this in the afterupdate of the combo?:

'Code for Afterupdate event of combobox
Private Sub cboDBname_AfterUpdate()
Me!txtDBPath = Me!cboDBname

Private Sub cmdExecute_Click()
On Error GoTo ErrHandler

With Me.txtDBPath
If Not IsNull(.Value) Then
If Len(Dir$(.Value, vbNormal)) Then
Me.lbxLDBInfo.RowSourceType = vbNullString
If (Me.chkUserRoster.Enabled And (Me.chkUserRoster))
Then
m_blnUseRosterLayout = True
Me.optDisplayOptions.Enabled = False
Call sUseUserRoster
Else
Me.optDisplayOptions.Enabled = True
m_blnUseRosterLayout = False
Call sDisplayUsers
End If
Me.lbxLDBInfo.RowSourceType = "fListFill"
End If
End If
End With
ExitHere:
Exit Sub
ErrHandler:
With Err
MsgBox "Error: " & .Number & vbCrLf & .Description, _
vbCritical Or vbOKOnly, .Source
End With
Resume ExitHere
End Sub
'end code for afterupdate event for combobox

I tried this but my user box was not populated.

Apr 26 '06 #10
Actually I have done it a couple of ways.

On one of my apps I added the following to the onopen event and it
works fine.

==============================
'V:\TEAM FOLDERS\Kelly's Team\EMEA MACD BR Pilot\EMEA MACD PROJ\EMEA
DB\EMEA DB Tables.mdb
Me.txtDBPath = "V:\SHARE FOLDER\Billing Validation\Billing Validation
Tables.mdb"
' If Len(.Value) Then
' Me.chkUserRoster.Enabled = fIsJet4DB(.Value)
Me.chkUserRoster.Enabled = True
Call cmdExecute_Click
' End If
================================================== ====

Apr 27 '06 #11

This discussion thread is closed

Replies have been disabled for this discussion.

Similar topics

3 posts views Thread by Vik Rubenfeld | last post: by
6 posts views Thread by Fan Ruo Xin | last post: by
5 posts views Thread by Dan C Douglas | last post: by
reply views Thread by =?Utf-8?B?cmZsYXphcm8=?= | last post: by
reply views Thread by XIAOLAOHU | last post: by
reply views Thread by leo001 | last post: by
reply views Thread by lumer26 | last post: by
reply views Thread by Vinnie | last post: by

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.