平常搞数据库操作多了就想把经常用的内容放在一起，我也懒，在一本书里的工程例子挑了一个bas，修修改改，凑合这用吧。
Public strCnn As String '数据库连接字符串
Public AdoCnn As ADODB.Connection '数据库连接
Public IsConnect As Boolean '判断是否连接 Private Sub Connect() '连接数据库
On Error GoTo Err:
If IsConnect = True Then '如果连接标记为真，则返回。否则会出错
Exit Sub
End If Set AdoCnn = New ADODB.Connection '关键New用于创建新对象cnn
With AdoCnn
.ConnectionString = strCnn
.ConnectionTimeout =
.Open
End With
IsConnect = True '设置连接标记，表示已经连接到数据库
Exit Sub
Err:
If Err = - Then
Set Cnn = Nothing
MsgBox Err.Description & "请检查数据库配置!", vbOKOnly + vbInformation, "Connect"
Else
MsgBox Err.Description & "请检查数据库配置!", vbExclamation, "Connect"
End If End Sub Public Sub Disconnect() '断开与数据库的连接
Dim rc As Long
If IsConnect = False Then Exit Sub '如果连接标记为假，标明已经断开连接，则直接返回
AdoCnn.Close '关闭连接 Set AdoCnn = Nothing
IsConnect = False
End Sub Public Sub DB_Connect() '使用Connect_Num控制数据库连接
Connect_Num = Connect_Num +
Connect
End Sub Public Sub DB_Disconnect()
If Connect_Num >= CONNECT_LOOP_MAX Then
Connect_Num =
Disconnect
End If
End Sub Public Sub DBapi_Disconnect() '强制关闭api方式访问的数据库，计数器复位
Connect_Num =
Disconnect
End Sub Public Sub ExecSql(ByVal TmpSql As String) '执行数据库操作语句
On Error GoTo Err:
Dim cmd As New ADODB.Command '创建Command对象cmd
DB_Connect '连接到数据库
Set cmd.ActiveConnection = AdoCnn '设置cmd的ActiveConnection属性，指定与其关联的数据库连接
cmd.CommandText = TmpSql '设置要执行的命令文本
cmd.Execute
Set cmd = Nothing
DB_Disconnect
Exit Sub
Err:
MsgBox Err.Description, , "ExecSql"
End Sub Public Function QuerySql(ByVal TmpSql As String) As ADODB.Recordset '执行数据库查询语句
On Error GoTo Err:
Dim rst As New ADODB.Recordset
DB_Connect '连接到数据库
If IsConnect = False Then Exit Function
Set rst.ActiveConnection = AdoCnn '设置rst的ActiveConnection属性，指定与其关联的数据库连接
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic '设置锁定类型
rst.Open TmpSql '打开记录集
Set QuerySql = rst '返回记录集
Exit Function
Err:
MsgBox Err.Description, , "QuerySql"
End Function Public Function GetFieldValue(FieldValue As Variant) As String
GetFieldValue = IIf(Not IsNull(FieldValue), FieldValue, "")
End Function