图中我是打开数据库后,又在另一个数据库打开了到此数据库的链接表,所以两个用户名是一样的
'===================================================================================================
'-函数名称: GetDbConnectedUsers
'-功能描述: 获取连接当前Access数据库的计算机名
'-输入参数: Delimiter 可选的,各连接计算机名之间的分隔符
'-返回参数: 调用成功返回由指定分隔符分隔的所有连接到当前数据库的计算机名,调用失败返回空字符串
'-使用示例: strUsers = GetDbConnectedUsers()
'-使用说明:
'-参 考: 微软例程
'-作 者: 红尘如烟
'-创作日期: 2007-7-1
'-修 改: 2010-4-16 红尘如烟
'===================================================================================================
Public Function GetDbConnectedUsers(Optional Delimiter As String = ";") As String
On Error GoTo Exit_GetDbConnectedUsers
Dim strTemp As String
Dim rst As Object
Set rst = CurrentProject.Connection.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
Do Until rst.EOF
strTemp = rst![COMPUTER_NAME]
GetDbConnectedUsers = GetDbConnectedUsers & Delimiter & Left$(strTemp, InStrRev(strTemp, vbNullChar) - 1)
rst.MoveNext
Loop
rst.Close
GetDbConnectedUsers = Mid$(GetDbConnectedUsers, 2)
Exit_GetDbConnectedUsers:
Set rst = Nothing
Exit Function
Err_GetDbConnectedUsers:
GetDbConnectedUsers = ""
Resume Exit_GetDbConnectedUsers
End Function
点击下载此附件