Как обновить имя сервера для всех связанных таблиц SQL Server ODBC с помощью Access VBA - PullRequest
Новая
       26

Как обновить имя сервера для всех связанных таблиц SQL Server ODBC с помощью Access VBA

1 голос
/ 10 мая 2019

Мне нужно предоставить способ обновления имени сервера во всех подключенных таблицах ODBC в базе данных Access. Все таблицы были перенесены из Access в экземпляр SQL Express. Опция необходима для обновления всех ссылок на внешние таблицы, чтобы они указывали на «Localhost \ SQLExpress» на экземпляр SQL на другом сервере. Имя базы данных останется непротиворечивым. Необходимо обновить только имя экземпляра сервера.

Я нашел примеры того, как это сделать для соединений с файлами базы данных Access и файлами Excel, но не для соединений ODBC с SQL Server. В одном посте здесь указывалось на необходимость измерения объекта 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 Ответ

1 голос
/ 10 мая 2019

Мы используем этот код для вызова 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
...