寻找表中自动编号字段名函数

Henry D. Sy

1. '---------------------------------------------------------------------------------------
   
2. ' Module    : IsAutoNum
   
3. ' DateTime  : 2011-12-07 22:00
   
4. ' Author    : Henry D. Sy
   
5. ' Purpose   : AutoNumIs("tbl1")
   
6. '---------------------------------------------------------------------------------------
   
7. Public Function AutoNumIs(ByVal tblName As String) As String
   
8.     Dim rs As New ADODB.Recordset
   
9.     Dim cnn As New ADODB.Connection
   
10.     Dim intCount As Integer
    
11.     Dim strName As String
    
12.     On Error GoTo AutoNumIs_Error
    
13. 
    
14.     Set cnn = CurrentProject.Connection
    
15.     rs.Open tblName, cnn, adOpenKeyset, adLockReadOnly
    
16.     For intCount = 0 To rs.Fields.Count - 1
    
17.         If rs.Fields(intCount).Properties("isautoincrement") Then
    
18.             strName = rs.Fields(intCount).Name
    
19.             Exit For
    
20.         End If
    
21.     Next
    
22.     If Len(strName) <> 0 Then
    
23.         AutoNumIs = strName
    
24.     Else
    
25.         AutoNumIs = "Not Find"
    
26.     End If
    
27.     rs.Close
    
28.     Set rs = Nothing
    
29. 
    
30.     On Error GoTo 0
    
31.     Exit Function
    
32. 
    
33. AutoNumIs_Error:
    
34. 
    
35.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    
36. End Function
    

复制代码

鱼儿游游

斑竹，我试了，发现有以下问题，能不能再改进一下。
要是当前ACCESS数据库，可以取回自动编号的字段。
要是读取另一个ACCESS数据库（用ADO不用链接表）里的数据表，则不能取回自动编号的字段。

andymark

把CNN 重设为打开另一个数据库的连接就行

鱼儿游游

andymark 发表于 2011-12-8 09:10
把CNN 重设为打开另一个数据库的连接就行

我试了，不知道为什么不行。

Henry D. Sy

鱼儿游游 发表于 2011-12-7 22:35
斑竹，我试了，发现有以下问题，能不能再改进一下。
要是当前ACCESS数据库，可以取回自动编号的字段。
要 ...

1. Public Function AutoNumIs(ByVal tblName As String) As String
   
2.     Dim rs As New ADODB.Recordset
   
3.     Dim cnn As New ADODB.Connection
   
4.     Dim intCount As Integer
   
5.     Dim strName As String
   
6.     On Error GoTo AutoNumIs_Error
   
7. 
   
8.     'Set cnn = CurrentProject.Connection
   
9.     cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
   
10.         CurrentProject.Path & "/ABC.mdb;Jet OLEDB:database password="
    
11.     cnn.Open
    
12.     rs.Open tblName, cnn, adOpenKeyset, adLockReadOnly
    
13.     For intCount = 0 To rs.Fields.Count - 1
    
14.         If rs.Fields(intCount).Properties("isautoincrement") Then
    
15.             strName = rs.Fields(intCount).Name
    
16.             Exit For
    
17.         End If
    
18.     Next
    
19.     If Len(strName) <> 0 Then
    
20.         AutoNumIs = strName
    
21.     Else
    
22.         AutoNumIs = "Not Find"
    
23.     End If
    
24.     rs.Close
    
25.     Set rs = Nothing
    
26. 
    
27.     On Error GoTo 0
    
28.     Exit Function
    
29. 
    
30. AutoNumIs_Error:
    
31. 
    
32.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    
33. End Function
    

复制代码

abc是你的库名，保存在一样的目录里

鱼儿游游

Henry D. Sy 发表于 2011-12-8 12:37
abc是你的库名，保存在一样的目录里

我用你的方法，写成下面的函数，但仍然不能取回自动编号字段，不知道错哪了，帮忙看看，多谢了。

1. Public Function GetIdentityField(strDatabaseName As String, strPwd As String, strTableName As String) As String
   
2. On Error GoTo Err_Handler
   
3.     Dim strFieldName As String
   
4.     Dim cn           As Object
   
5.     Dim rst          As Object
   
6.     Dim strConnect   As String
   
7.     Dim strSQL       As String
   
8.     Dim intCount     As Integer
   
9.     strFieldName = ""
   
10.     '参数（数据库名）处理
    
11.     If strDatabaseName Like ".\*" Then strDatabaseName = CurrentProject.Path & Mid(strDatabaseName, 2)
    
12.     If Not strDatabaseName Like "[A-z]:*" Then strDatabaseName = CurrentProject.Path & "" & strDatabaseName
    
13.     '定义ACCESS链接串
    
14.     strConnect = "Provider=Microsoft.Jet.OLEDB.4.0" & ";Data Source=" & strDatabaseName & ";Jet OLEDB:Database Password=" & strPwd
    
15.     '用ADO通过OLEDB直接连接数据库
    
16.     Set cn = Nothing
    
17.     Set cn = CreateObject("ADODB.Connection")
    
18.     With cn
    
19.         .ConnectionString = strConnect
    
20.         .CursorLocation = adUseClient
    
21.         .ConnectionTimeout = 15
    
22.         .CommandTimeout = 30
    
23.         .Open
    
24.     End With
    
25.     '打开ADO记录集
    
26.     strSQL = "SELECT * FROM [" & strTableName & "]"
    
27.     Set rst = Nothing
    
28.     Set rst = CreateObject("ADODB.Recordset")
    
29.     With rst
    
30.         .Source = strSQL
    
31.         .ActiveConnection = cn
    
32.         .CursorLocation = adUseClient  '3
    
33.         .CursorType = adOpenKeyset
    
34.         .LockType = adLockReadOnly
    
35.         .Open
    
36.     End With
    
37.     '查找自动编号字段
    
38.     For intCount = 0 To rst.Fields.Count - 1
    
39.          If rst.Fields(intCount).Properties("isautoincrement") Then
    
40.              strFieldName = rst.Fields(intCount).Name
    
41.              Exit For
    
42.          End If
    
43.     Next
    
44.     rst.Close
    
45.     cn.Close
    
46. Exit_Handler:
    
47.     GetIdentityField = strFieldName
    
48.     Set rst = Nothing
    
49.     Set cn = Nothing
    
50.     Exit Function
    
51. Err_Handler:
    
52.     strFieldName = ""
    
53.     MsgBox Err.Description, vbExclamation, "查询表标识列的列名出错"
    
54.     Resume Exit_Handler
    
55. End Function

复制代码

Henry D. Sy

视乎漏掉最终的赋值
GetIdentityField=strFieldName

鱼儿游游

Henry D. Sy 发表于 2011-12-8 15:21
视乎漏掉最终的赋值
GetIdentityField=strFieldName

没有呀

Henry D. Sy

GetIdentityField=strFieldName
rst.Close
cn.Close

鱼儿游游

Henry D. Sy 发表于 2011-12-8 17:05
GetIdentityField=strFieldName
rst.Close
cn.Close

关闭记录集、关闭连接不影响strFieldName的值呀。

多谢，斑竹，这问题我解决了，是游标的问题。