使用表单组合框更改连接字符串

时间:2016-03-29 16:13:02

标签: ms-access

我正在设置一个访问表单来输入查询的参数,以及选择要连接的所需数据库服务器。这将需要运行以从多个建筑物收集数据,每个建筑物具有不同的服务器名称。所有表名和字段都是通用的。

我有服务器名称,通用ID和PW,数据库名称,网络名称和用于连接SQL服务器的端口。除服务器名称外,所有建筑物的所有建筑物都相同。因此,只需要在连接字符串中更改服务器名称。所有这些信息都保存在表格中。

我已经从堆栈和其他网站上阅读了几篇帖子,但是无法完成任何工作。

我希望能够做的是使用组合框选择我想要连接的建筑物名称,并让该组合框输出该建筑物的服务器名称。 (这我知道如何在属性窗口中执行)然后让VBA代码将链接表更新到新服务器。

我不知道/理解的是如何将组合框输出传递给要在连接字符串中使用的VBA变量,也不编写代码来更新连接字符串。我发现的大部分内容都是如何将DSN更改为无DSN或更改特定表。我想一次更新所有链接表。

我想一般了解代码是如何工作的,因此非常感谢任何ELI5评论。

1 个答案:

答案 0 :(得分:0)

这是一个创建连接字符串的函数:

Public Function ConnectionString( _
    ByVal Hostname As String, _
    ByVal Database As String, _
    ByVal Username As String, _
    ByVal Password As String) _
    As String

' Create ODBC connection string from its variable elements.
' 2016-04-24. Cactus Data ApS, CPH.

    Const AzureDomain   As String = ".windows.net"
    Const OdbcConnect   As String = _
        "ODBC;" & _
        "DRIVER=SQL Server Native Client 11.0;" & _
        "Description=Your Application;" & _
        "APP=Microsoft® Access;" & _
        "SERVER={0};" & _
        "DATABASE={1};" & _
        "UID={2};" & _
        "PWD={3};" & _
        "Trusted_Connection=No;"

    Dim FullConnect     As String

    If Right(Hostname, Len(AzureDomain)) = AzureDomain Then
        ' Azure SQL connection.
        ' Append servername to username.
        Username = Username & "@" & Split(Hostname)(0)
    End If
    FullConnect = OdbcConnect
    FullConnect = Replace(FullConnect, "{0}", Hostname)
    FullConnect = Replace(FullConnect, "{1}", Database)
    FullConnect = Replace(FullConnect, "{2}", Username)
    FullConnect = Replace(FullConnect, "{3}", Password)

    ConnectionString = FullConnect

End Function

这是一个重新链接表和传递查询的函数:

Public Function AttachSqlServer( _
    ByVal Hostname As String, _
    ByVal Database As String, _
    ByVal Username As String, _
    ByVal Password As String) _
    As Boolean

' Attach all tables linked via ODBC to SQL Server or Azure SQL.
' 2016-04-24. Cactus Data ApS, CPH.

    Const cstrQuery1    As String = "_Template"
    Const cstrQuery2    As String = "_TemplateRead"
    Const cstrQuery3    As String = "VerifyConnection"

    Const cstrDbType    As String = "ODBC"
    Const cstrAcPrefix  As String = "dbo_"

    Dim dbs             As DAO.Database
    Dim tdf             As DAO.TableDef
    Dim strConnect      As String
    Dim strName         As String

    On Error GoTo Err_AttachSqlServer

    Set dbs = CurrentDb
    strConnect = ConnectionString(Hostname, Database, Username, Password)

    For Each tdf In dbs.TableDefs
        strName = tdf.Name
        If Asc(strName) <> Asc("~") Then
            If InStr(tdf.Connect, cstrDbType) = 1 Then
                If Left(strName, Len(cstrAcPrefix)) = cstrAcPrefix Then
                    tdf.Name = Mid(strName, Len(cstrAcPrefix) + 1)
                End If
                tdf.Connect = strConnect
                tdf.RefreshLink
                Debug.Print Timer, tdf.Name, tdf.SourceTableName, tdf.Connect
                DoEvents
            End If
        End If
    Next
    dbs.QueryDefs(cstrQuery1).Connect = strConnect
    dbs.QueryDefs(cstrQuery2).Connect = strConnect
    dbs.QueryDefs(cstrQuery3).Connect = strConnect
    Debug.Print "Done!"

    AttachSqlServer = True

Exit_AttachSqlServer:
    Set tdf = Nothing
    Set dbs = Nothing
    Exit Function

Err_AttachSqlServer:
    Call ErrorMox
    Resume Exit_AttachSqlServer

End Function

这应该让你去。