本文介绍两个函数,链接表函数,用于前后台的数据库管理中,可分别连接Access数据库和SQL数据库,源码示例,(摘自Access 2007开发全书)
请将下列程序放置在公用模块中
1. 链接Access 2007(含Access 2003)中的数据表函数
Public Function 链接表(数据库名 As String, Optional 密码 As String) As Boolean
'连接指定的数据库中的表
'2007下使用方法:
'Call 公用模块.链接表("营销合同管理数据.accdb", "123")
'Call 公用模块.链接表("营销合同管理数据.accdb")
'2003下使用方法:
'Call 公用模块.链接表("营销合同管理数据.mdb", "123")
'Call 公用模块.链接表("营销合同管理数据.mdb")
Dim dbs As Database
Dim Tdf As TableDef
Dim Lianjie As String
Dim MingCheng As String
On Error GoTo err1
链接表 = False
MingCheng = CurrentProject.Path & "\" & 数据库名
'如果有链接表,则删除
Set dbs = CurrentDb
For Each Tdf In CurrentDb.TableDefs
If Len(Tdf.Connect) > 0 Then
'如果是链接表,则删除
DoCmd.DeleteObject acTable, Tdf.Name
End If
Next Tdf
dbs.Close
'重新建立表链接
'设置密码字符串
If 密码 <> "" Then
Lianjie = ";PWD=" & 密码
Else
Lianjie = ";"
End If
Set dbs = OpenDatabase(MingCheng, False, False, Lianjie)
For Each Tdf In dbs.TableDefs
'如果是本地表才连接
If Len(Tdf.Connect) = 0 And Tdf.Attributes = 0 Then
DoCmd.TransferDatabase acLink, "Microsoft Access", MingCheng, acTable, Tdf.Name, Tdf.Name, False
End If
Next Tdf
dbs.Close
Set dbs = Nothing
链接表 = True
Exit Function
err1:
链接表 = False
MsgBox Err.Description, vbExclamation, "错误!"
End Function
2 、链接SQL Server数据库中的表函数
Public Function SQL链接表(数据库名 As String, IP地址 As String, 用户名, Optional 密码 As String) As Boolean
'连接指定的数据库中的表
'使用方法:Call 公用模块.SQL链接表("进销存管理系统SQL","127.0.0.1","sa","1234")
'使用方法:Call 公用模块.SQL链接表("进销存SQL","127.0.0.1","sa")
Dim dbs As Database
Dim Tdf As TableDef
Dim Lianjie As String
Dim MingCheng As String
Dim s As String
'On Error GoTo Err1
SQL链接表 = False
MingCheng = ""
'如果有链接表,则删除
Set dbs = CurrentDb
For Each Tdf In CurrentDb.TableDefs
If Len(Tdf.Connect) > 0 Then
'如果是链接表,则删除
DoCmd.DeleteObject acTable, Tdf.Name
End If
Next Tdf
dbs.Close
MingCheng = 数据库名
'重新建立表链接
'设置密码字符串
If 密码 <> "" Then
Lianjie = "ODBC;DRIVER=SQL Server;SERVER=" & IP地址 & ";UID=" & 用户名 & ";" & "PWD=" & 密码 & ";" & "DATABASE=" & 数据库名
Else
Lianjie = "ODBC;DRIVER=SQL Server;SERVER=" & IP地址 & ";UID=" & 用户名 & ";PWD=;" & "DATABASE=" & 数据库名
End If
Set dbs = OpenDatabase(MingCheng, True, False, Lianjie)
For Each Tdf In dbs.TableDefs
'如果是本地表才连接
If Len(Tdf.Connect) = 0 And Tdf.Attributes = 0 Then
s = Mid(Tdf.Name, 5)
DoCmd.TransferDatabase acLink, "ODBC", Lianjie, acTable, Tdf.Name, s, False
End If
Next Tdf
dbs.Close
Set dbs = Nothing
SQL链接表 = True
Exit Function
Err1:
SQL链接表 = False
MsgBox Err.Description, vbExclamation, "错误!"
End Function