【源码】自制链接表管理器

hi，大家好呀！

前几天更新了个视频，教大家做了一个链接表的管理器，今天把文字内容给到大家，至于什么原因需要自己做一个链接表管理器，我在视频中有讲到，因为系统自带的链接表管理器没有筛选功能。

【自己动手丰衣足食】自制链表表管理器

01、创建表

首先，我们先来创建一张表，用于保存链接表或者视图的名称，表名称：T_LinkTables；

字段名	字段类型	是否为主键
ID	自动编号	是
FTableName	短文本	否
FTableType	短文本	否

02、创建窗体

接着，我们就需要来创建窗体了

控件	控件名称
文本框	txtSearch
列表框	List_table
按钮（刷新）	btnRefresh
按钮（确定）	btnOK
按钮（取消）	btnCancel
标签	Lab_Msg

列表框这里要调整两个属性，格式——>列数：2；其他——>多重选择：简单

具体的窗体排版参考下图：

03、添加代码

窗体、表都设计好了，那我们就需要来添加代码了：

刷新按钮的单击事件：

注意：数据库的链接的内容要替换成你自己的链接信息，不然后会报错

Private Sub btnRefresh_Click()
    On Error GoTo ErrorHandler
    Dim strConnect As String
    Dim cnn As Object
    Dim rst As Object
    Dim strSQL As String
    Dim lng As Long

    '数据库连接字符串，这里需要替换成自己的链接信息
    strConnect = "Provider=SQLOLEDB" & _
        ";Data Source=服务器地址" & _
        ";Initial Catalog=数据库名称" & _
        ";User ID=用户名" & _
        ";Password=密码"

    Set cnn = CreateObject("ADODB.Connection")
    cnn.connectionString = strConnect
    cnn.Open
    lng = 1
    strSQL = "select count(1) FCount from INFORMATION_SCHEMA.TABLES  "
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open strSQL, cnn, 2, 3
    SysCmd acSysCmdInitMeter, "正在刷新。。。", rst!FCount
    rst.Close
    strSQL = "select * from INFORMATION_SCHEMA.TABLES order by TABLE_NAME"
    rst.Open strSQL, cnn, 2, 3
    Do Until rst.EOF
        If Nz(DLookup("FTableName", "T_LinkTables", "FTableName='" & rst!TABLE_NAME & "' and FTableType='" & rst!TABLE_TYPE & "'"), "") = "" Then
            strSQL = "insert into T_LinkTables(FTableName,FTableType)values('" & rst!TABLE_NAME & "','" & rst!TABLE_TYPE & "')"
            CurrentDb.Execute strSQL
        End If

        rst.MoveNext
        lng = lng + 1


        SysCmd acSysCmdUpdateMeter, lng
    Loop
    rst.Close
    cnn.Close
    Me.List_table.RowSource = "select FTableName ,FTableType from  T_LinkTables "
    SysCmd acSysCmdClearStatus
    Me.Lab_Msg.Caption = "刷新完成！！！"
    MsgBox "刷新完成！", vbInformation

ExitHere:
    Exit Sub
ErrorHandler:
    MsgBox Err.Description, vbCritical
    Resume ExitHere
End Sub

确定按钮的单击事件：

这里的链接字符串也需要调整的哦！

Private Sub btnOK_Click()
    On Error GoTo ErrorHandler
    Dim varItem As Variant
    Dim dbs                 As Object           'Database
    Dim tdf                 As Object           'DAO.TableDef
    Dim sTable As String
    Dim strCon As String
    '
    strCon = "ODBC;DRIVER=SQL Server;SERVER=服务器地址;DATABASE=数据库名称;UID=用户名;PWD=密码"
    Set dbs = CurrentDb
    For Each varItem In Me.List_table.ItemsSelected
        sTable = Me.List_table.ItemData(varItem)
        '重新创建链接表
        Set tdf = dbs.CreateTableDef(sTable)
        tdf.Connect = strCon
        tdf.SourceTableName = sTable
        dbs.TableDefs.Append tdf
        tdf.RefreshLink

    Next
    Application.RefreshDatabaseWindow
    MsgBox "链接表添加成功。", vbInformation
ExitHere:
    Exit Sub
ErrorHandler:
    MsgBox Err.Description, vbCritical
    Resume ExitHere
End Sub

最后是剩余的代码

'加载事件
Private Sub Form_Load()
    Me.Lab_Msg.Caption = ""
    Me.List_table.RowSource = "select FTableName ,FTableType from  T_LinkTables "
End Sub
'文本框的更改事件
Private Sub txtSearch_Change()
    Dim i As Long
    Dim searchString As String

    searchString = Me.txtSearch.Text
    Me.List_table.RowSource = "select  FTableName ,FTableType  from T_LinkTables where FTableName like '*" & searchString & "*' "
End Sub
'取消按钮的单击事件
Private Sub btnCancel_Click()
    DoCmd.Close acForm, Me.Name
End Sub

代码的原理我在视频里都有讲过了，大家有不明白的，可以查看一下。

04、运行测试

最后，就是运行测试一下，这里就不再赘述了，视频里面更加的直观，大家可以在视频里看一下具体的运行效果。

好了，大家赶紧去试一下吧。记得给我点赞哦！