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

红尘如烟

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

1. '===================================================================================================
   
   
2. '-函数名称：  GetDbConnectedUsers
   
   
3. '-功能描述：  获取连接当前Access数据库的计算机名
   
   
4. '-输入参数：  Delimiter      可选的，各连接计算机名之间的分隔符
   
   
5. '-返回参数：  调用成功返回由指定分隔符分隔的所有连接到当前数据库的计算机名，调用失败返回空字符串
   
   
6. '-使用示例：  strUsers = GetDbConnectedUsers()
   
   
7. '-使用说明：
   
   
8. '-参　　考：  微软例程
   
   
9. '-作　　者：　红尘如烟
   
   
10. '-创作日期：  2007-7-1
    
    
11. '-修    改：  2010-4-16 红尘如烟
    
    
12. '===================================================================================================
    
    
13. Public Function GetDbConnectedUsers(Optional Delimiter As String = ";") As String
    
    
14.     On Error GoTo Exit_GetDbConnectedUsers
    
    
15.    
    
    
16.     Dim strTemp As String
    
    
17.     Dim rst     As Object
    
    
18.    
    
    
19.     Set rst = CurrentProject.Connection.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
    
    
20.     Do Until rst.EOF
    
    
21.         strTemp = rst![COMPUTER_NAME]
    
    
22.         GetDbConnectedUsers = GetDbConnectedUsers & Delimiter & Left$(strTemp, InStrRev(strTemp, vbNullChar) - 1)
    
    
23.         rst.MoveNext
    
    
24.     Loop
    
    
25.     rst.Close
    
    
26.     GetDbConnectedUsers = Mid$(GetDbConnectedUsers, 2)
    
    
27.    
    
    
28. Exit_GetDbConnectedUsers:
    
    
29.     Set rst = Nothing
    
    
30.     Exit Function
    
    
31.    
    
    
32. Err_GetDbConnectedUsers:
    
    
33.     GetDbConnectedUsers = ""
    
    
34.     Resume Exit_GetDbConnectedUsers
    
    
35. End Function

复制代码

真主

原str改为strUsers才可用

红尘如烟

晕，想不到居然还会犯这种低级错误！多谢2楼的提醒

jpj123123

虚心学习了!!!!!!!!

yasen88

好好学习

yasen88

虚心一点好

ABCaccess

谢谢你与大众分享

ynjxw

我的文件有几个人在用,但是怎么只能获得一个计算机名?

ivychou

我是刚刚才学习这个数据库的，对于编程更是不懂，现在老总要我弄一个数据库，可以分类小计、计算百分比、以及总计？

请各位高手帮帮忙。[:12]

7777777

谢谢你与大众分享