vb+access

 Attribute VB_Name = "MyMDB"
Option Explicit

'数据库联接
Dim com As ADODB.Command
Dim cn As ADODB.Connection

'程序的路径
Private MDBFile  As String
Private MDBOpen As Boolean

Public Function GetAppPath() As String
    Dim AppPath As String
   
    AppPath = App.Path
    If Right(AppPath, 1) <> "/" Then AppPath = AppPath & "/"
    GetAppPath = AppPath
End Function

'初始化全局变量
Public Function OpenMDB(File As String) As Boolean
    If Dir(File) = "" Then
        MsgBox "数据库文件 '" & File & "' 丢失,程序运行失败！", vbOKOnly, "致命错误！"
        OpenMDB = False
        Exit Function
    End If
   
    '联接数据库
    On Error GoTo error
    Set cn = New ADODB.Connection
    Set com = New ADODB.Command
    cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & File & ";Persist Security Info=False"
    MDBFile = File
    cn.Open  '创建数据库连接
    com.CommandType = adCmdText     '定义ADO命令类型
    com.ActiveConnection = cn
    OpenMDB = True
    Exit Function
error:
    OpenMDB = False
   
End Function

Public Function SQL(strSQL As String) As ADODB.Recordset
    On Error GoTo error
    com.CommandText = strSQL
    Set SQL = com.Execute
    Exit Function
error:
    Set SQL = Nothing
End Function

Public Function SQL2(strSQL As String) As Long
    Dim res As Long
   
    On Error GoTo error
    cn.Execute strSQL, res
    SQL2 = res
    Exit Function
error:
    SQL2 = 0
End Function

Public Function GetCon() As ADODB.Connection
    Set GetCon = cn
End Function

Public Function GetCom() As Command
    Set GetCom = com
End Function

Public Function GetMDBName() As String
    GetMDBName = Mid(MDBFile, InStrRev(MDBFile, "/") + 1)
End Function

http://download.csdn.net/source/349955