寻找表中自动编号字段名函数 - Office中国论坛/Access中国论坛

'---------------------------------------------------------------------------------------
' Module : IsAutoNum
' DateTime : 2011-12-07 22:00
' Author : Henry D. Sy
' Purpose : AutoNumIs("tbl1")
'---------------------------------------------------------------------------------------
Public Function AutoNumIs(ByVal tblName As String) As String
Dim rs As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Dim intCount As Integer
Dim strName As String
On Error GoTo AutoNumIs_Error
Set cnn = CurrentProject.Connection
rs.Open tblName, cnn, adOpenKeyset, adLockReadOnly
For intCount = 0 To rs.Fields.Count - 1
If rs.Fields(intCount).Properties("isautoincrement") Then
strName = rs.Fields(intCount).Name
Exit For
End If
Next
If Len(strName) <> 0 Then
AutoNumIs = strName
Else
AutoNumIs = "Not Find"
End If
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Function
AutoNumIs_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
End Function

复制代码

Public Function AutoNumIs(ByVal tblName As String) As String
Dim rs As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Dim intCount As Integer
Dim strName As String
On Error GoTo AutoNumIs_Error
'Set cnn = CurrentProject.Connection
cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
CurrentProject.Path & "/ABC.mdb;Jet OLEDB:database password="
cnn.Open
rs.Open tblName, cnn, adOpenKeyset, adLockReadOnly
For intCount = 0 To rs.Fields.Count - 1
If rs.Fields(intCount).Properties("isautoincrement") Then
strName = rs.Fields(intCount).Name
Exit For
End If
Next
If Len(strName) <> 0 Then
AutoNumIs = strName
Else
AutoNumIs = "Not Find"
End If
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Function
AutoNumIs_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
End Function

复制代码

Public Function GetIdentityField(strDatabaseName As String, strPwd As String, strTableName As String) As String
On Error GoTo Err_Handler
Dim strFieldName As String
Dim cn As Object
Dim rst As Object
Dim strConnect As String
Dim strSQL As String
Dim intCount As Integer
strFieldName = ""
'参数（数据库名）处理
If strDatabaseName Like ".\*" Then strDatabaseName = CurrentProject.Path & Mid(strDatabaseName, 2)
If Not strDatabaseName Like "[A-z]:*" Then strDatabaseName = CurrentProject.Path & "" & strDatabaseName
'定义ACCESS链接串
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0" & ";Data Source=" & strDatabaseName & ";Jet OLEDB:Database Password=" & strPwd
'用ADO通过OLEDB直接连接数据库
Set cn = Nothing
Set cn = CreateObject("ADODB.Connection")
With cn
.ConnectionString = strConnect
.CursorLocation = adUseClient
.ConnectionTimeout = 15
.CommandTimeout = 30
.Open
End With
'打开ADO记录集
strSQL = "SELECT * FROM [" & strTableName & "]"
Set rst = Nothing
Set rst = CreateObject("ADODB.Recordset")
With rst
.Source = strSQL
.ActiveConnection = cn
.CursorLocation = adUseClient '3
.CursorType = adOpenKeyset
.LockType = adLockReadOnly
.Open
End With
'查找自动编号字段
For intCount = 0 To rst.Fields.Count - 1
If rst.Fields(intCount).Properties("isautoincrement") Then
strFieldName = rst.Fields(intCount).Name
Exit For
End If
Next
rst.Close
cn.Close
Exit_Handler:
GetIdentityField = strFieldName
Set rst = Nothing
Set cn = Nothing
Exit Function
Err_Handler:
strFieldName = ""
MsgBox Err.Description, vbExclamation, "查询表标识列的列名出错"
Resume Exit_Handler
End Function

复制代码