【access源码】一个获取连接当前access数据库的用户名的函数

时　间:2010-04-16 23:14:10
作　者:红尘如烟   ID：10768  城市：成都
摘　要:获取有哪些用户连接到了当前数据库
正　文:

图中我是打开数据库后，又在另一个数据库打开了到此数据库的链接表，所以两个用户名是一样的

'===================================================================================================
'-函数名称：  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

点击下载此附件