我正在设置一个访问表单来输入查询的参数,以及选择要连接的所需数据库服务器。这将需要运行以从多个建筑物收集数据,每个建筑物具有不同的服务器名称。所有表名和字段都是通用的。
我有服务器名称,通用ID和PW,数据库名称,网络名称和用于连接SQL服务器的端口。除服务器名称外,所有建筑物的所有建筑物都相同。因此,只需要在连接字符串中更改服务器名称。所有这些信息都保存在表格中。
我已经从堆栈和其他网站上阅读了几篇帖子,但是无法完成任何工作。
我希望能够做的是使用组合框选择我想要连接的建筑物名称,并让该组合框输出该建筑物的服务器名称。 (这我知道如何在属性窗口中执行)然后让VBA代码将链接表更新到新服务器。
我不知道/理解的是如何将组合框输出传递给要在连接字符串中使用的VBA变量,也不编写代码来更新连接字符串。我发现的大部分内容都是如何将DSN更改为无DSN或更改特定表。我想一次更新所有链接表。
我想一般了解代码是如何工作的,因此非常感谢任何ELI5评论。
答案 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
这应该让你去。