vba - 如果主 ODBC DSN 不存在,则使用备用 ODBC DSN
问题描述
我有多个用户使用两个 ODBC 系统 DSN 之一通过 Access 连接到 SQL Server:REPORT 和 REPORTS。除了名称之外,它们是相同的。我会定期更新或创建新的基于 Access 的工具,然后将其部署到共享网络驱动器。我目前必须维护每个工具的两个版本——一个使用 REPORT,另一个使用 REPORTS。我正在寻找一种方法来测试和重新链接表格:
- 如果 REPORT 存在,请使用它并重新链接表。
- 否则,如果 REPORTS 存在,请使用它并重新链接表。
- 否则返回错误信息。
我有在 VBA 中使用无 DSN 连接的经验,如果无法测试已经存在的 ODBC 连接,这可能是一个可行的选择。理想情况下,我会让 IT 对 DSN 名称进行标准化,但历史如此之深,以至于我无法轻易确定谁使用哪个 DSN。
解决方案
抢,
下面是一些代码,它首先返回有效的 DSN(通过尝试从列出的两个 DSN 中的每一个导入测试表),然后循环访问数据库中的所有链接表以正确设置 DSN(如果需要):
Function fGetODBCName() As String
On Error GoTo E_Handle
DoCmd.DeleteObject acTable, "dbo_tblTest"
DoCmd.TransferDatabase acLink, "ODBC Database", "ODBC;DSN=REPORT;Trusted_Connection=Yes;DATABASE=TEST", acTable, "tblUser", "dbo_tblTest"
If Not IsNull(DLookup("Name", "MSysObjects", "Name='dbo_tblTest'")) Then
fGetODBCName = CurrentDb.TableDefs("dbo_tblTest").Connect
Else
DoCmd.TransferDatabase acLink, "ODBC Database", "ODBC;DSN=REPORTS;Trusted_Connection=Yes;DATABASE=TEST", acTable, "tblUser", "dbo_tblTest"
If Not IsNull(DLookup("Name", "MSysObjects", "Name='dbo_tblTest'")) Then
fGetODBCName = CurrentDb.TableDefs("dbo_tblTest").Connect
End If
End If
DoCmd.DeleteObject acTable, "dbo_tblTest"
fExit:
On Error Resume Next
Exit Function
E_Handle:
Select Case Err.Number
Case 3146 ' DSN does not exist
Resume Next
Case 7874 ' dbo_tblTest does not exist so cannot delete it
Resume Next
Case Else
MsgBox Err.Description & vbCrLf & vbCrLf & "fGetODBCName", vbOKOnly + vbCritical, "Error: " & Err.Number
End Select
Resume fExit
End Function
Sub sRelinkODBC()
On Error GoTo E_Handle
Dim db As DAO.Database
Dim lngLoop1 As Long
Dim lngCount As Long
Dim strConnect As String
Dim strLocal As String
Dim strSource As String
strConnect = fGetODBCName
If Len(strConnect) > 0 Then
Set db = DBEngine(0)(0)
db.TableDefs.Refresh
lngCount = db.TableDefs.Count - 1
For lngLoop1 = lngCount To 0 Step -1
If Len(db.TableDefs(lngLoop1).Connect) > 0 Then
If db.TableDefs(lngLoop1).Connect <> strConnect Then ' only relink if needed
strLocal = db.TableDefs(lngLoop1).Name
strSource = db.TableDefs(lngLoop1).SourceTableName
DoCmd.DeleteObject acTable, strLocal
DoCmd.TransferDatabase acLink, "ODBC Database", strConnect, acTable, strSource, strLocal
End If
End If
Next lngLoop1
db.TableDefs.Refresh
Else ' not able to find a suitable DSN
End If
sExit:
On Error Resume Next
Set db = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sRelinkODBC", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
虽然这可行,但我强烈建议您与您的系统管理员交谈,并让他们使用组策略向所有用户推出单个 DSN。
高温高压
推荐阅读
- javascript - 如何在 ComboBoxListItemPicker 上设置选定的值?@pnp/spfx-controls-react
- python - Python 日期未正确绘制
- javascript - 如何将 Base64 编码的字符串转换为可以在 chrome 浏览器中显示的任何其他图像格式
- python - python elasticsarch集成
- typo3 - TYPO3 Extbase 表单引用者大小写错误
- python - 如何对包含在对象中的列表进行排序
- excel - 仅在过滤的范围/单元格上使用 IFERROR 和 VLOOKUP(动态公式/代码)
- c# - 在c#中达到一定大小时创建csv文件
- python-3.x - Python3 - 从文件中读取混合数据并将读取的值转换为浮点数
- azure - Azure B2C 未将电子邮件地址作为输入声明发送到 REST API 验证服务