如何使用 Access VBA 更新所有 ODBC 链接的 SQL Server 表的服务器名称
Posted
技术标签:
【中文标题】如何使用 Access VBA 更新所有 ODBC 链接的 SQL Server 表的服务器名称【英文标题】:How to update the server name for all ODBC linked SQL Server tables using Access VBA 【发布时间】:2019-05-10 03:24:29 【问题描述】:我需要能够提供一种方法来更新 Access 数据库中所有 ODBC 链接表连接中的服务器名称。所有表都已从 Access 迁移到 SQL Express 实例。需要一个选项来更新所有外部表链接以从“Localhost\SQLExpress”指向另一台服务器上的 SQL 实例。数据库名称将保持一致。只需更新服务器实例名称。
我找到了如何连接到 Access 数据库文件和 Excel 文件的示例,而不是到 SQL Server 的 ODBC 连接。这里的一篇文章指出需要标注一个 db 对象并直接使用它,而不是尝试直接使用 CurrentDb。这让我更进一步,但现在代码在尝试将新连接字符串分配给 TableDef 时因类型转换而失败。
Dim OldServer As String
Dim NewServer As String
Dim OldPath As String
Dim NewPath As String
Dim strPath As String
NewServer = Me.NewServerInstance ' get new Server Instance name from form
OldPath = GetCurrentPath("Version")
'Parse old name from the ODBC connection string
OldServer = Replace(Left(OldPath, InStr(GetCurrentPath("Version"), "UID=") - 2), "ODBC Driver 13 for SQL Server;SERVER=", "")
NewPath = Replace(OldPath, OldServer, NewServer)
If NewServer = OldServer Then
GoTo UpdateInstance_Click_Exit
Else
'update all table connection strings.
'Loop & replace Old server instance with New server instance
Dim Db As DAO.Database
Set Db = CurrentDb
Dim td As DAO.TableDef
For Each td In Db.TableDefs
If (td.Attributes And dbAttachedODBC) = dbAttachedODBC Then
Db.TableDefs(td).Connect = NewPath 'getting a datatype conversion error here...
Db.TableDefs(td).RefreshLink
' MsgBox (db.TableDefs(td).Connect)
End If
Next
End If
代码示例是我想出的。有一条注释指示发生数据类型转换错误的位置。我想我需要知道这是否可能,或者我是否正在尝试做一些不可能的事情,或者只是以错误的方式去做......
【问题讨论】:
【参考方案1】:我们在您调用 AttachSqlServer 时使用此代码,需要四个参数:
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=Application Name;" & _
"APP=Microsoft? Access;" & _
"SERVER=0;" & _
"DATABASE=1;" & _
"UID=2;" & _
"PWD=3;" & _
"Trusted_Connection=4;"
' Const cstrConnect As String = _
' "ODBC;Driver=SQL Server Native Client 11.0;Server=(localdb)\MSSQLLocalDB;Database=Test;Trusted_Connection=Yes"
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)
FullConnect = Replace(FullConnect, "4", IIf(Username & Password = "", "Yes", "No"))
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 cstrDbType As String = "ODBC"
Const cstrAcPrefix As String = "dbo_"
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim qdf As DAO.QueryDef
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
For Each qdf In dbs.QueryDefs
If qdf.Connect <> "" Then
Debug.Print Timer, qdf.Name, qdf.Type, qdf.Connect
qdf.Connect = strConnect
End If
Next
Debug.Print "Done!"
AttachSqlServer = True
Exit_AttachSqlServer:
Set tdf = Nothing
Set dbs = Nothing
Exit Function
Err_AttachSqlServer:
' Call ErrorMox
Resume Exit_AttachSqlServer
End Function
【讨论】:
太棒了!这就像一个魅力。我认为我缺少的关键部分是 RefreshLink。以上是关于如何使用 Access VBA 更新所有 ODBC 链接的 SQL Server 表的服务器名称的主要内容,如果未能解决你的问题,请参考以下文章
如何在 ms-access VBA 中检索表的 odbc 数据库名称
如何使用 MySQl 的 ODBC 连接器在 MS Access 中的 VBA 中执行和查询?
通过 VBA 在 MS Access 中自动链接/刷新 ODBC 链接表
从 MS Access VBA 通过 ODBC 进行 MySQL 查询:ADODB 异步执行不起作用
在 Access 中使用 ODBC 连接到 MS SQL Server 2012:手动调用查询和在 VBA 中调用查询之间的巨大时间差异