Sub 链接SQLServer表()
    Dim cnn As String
    Dim dbs As Object
    Dim tdf As Object
    Dim strConnect As String
    Dim arr As Variant
    Dim ar As String
    Dim i As Integer
    On Error GoTo errmsg
    ar = ("表1,表2,表3,表n") '要链接的SQL Server数据库表名
    arr = Split(ar, ",")
    For i = LBound(arr) To UBound(arr)
        Set dbs = CurrentDb
       strConnect = "ODBC;DRIVER=SQL Server;SERVER=IP地址,1433;DATABASE=数据库名;UID=sa;PWD=密码"
        Set tdf = dbs.CreateTableDef(arr(i))  '创建链接表,命名为arr(i)
        tdf.Connect = strConnect
        tdf.SourceTableName = arr(i)    'SQL源表
        dbs.TableDefs.Append tdf
        Set dbs = Nothing
        Set tdf = Nothing
        Application.RefreshDatabaseWindow  '刷新
    Next
    MsgBox "创建成功，请查看表"
    Exit Sub
errmsg:
    Set dbs = Nothing
    Set tdf = Nothing
    MsgBox Err.Description
End Sub