Измените встроенную строку подключения в макросе Excel

У меня есть документ Excel, у которого есть макрос, который при запуске изменит CommandText этого соединения, чтобы передать параметры из электронной таблицы Excel, например:

Sub RefreshData()
ActiveWorkbook.Connections("Job_Cost_Code_Transaction_Summary")
  .OLEDBConnection.CommandText = "Job_Cost_Code_Transaction_Summary_Percentage_Pending @monthEndDate='" & Worksheets("Cost to Complete").Range("MonthEndDate").Value & "', @job ='" & Worksheets("Cost to Complete").Range("Job").Value & "'"
ActiveWorkbook.Connections("Job_Cost_Code_Transaction_Summary").Refresh
End Sub

Я бы хотел, чтобы обновление не только изменяло команду соединения, но и изменяло соединение, поскольку я хотел бы использовать его и с другой базой данных:

Так же, как макрос заменяет параметры команды на значения из электронной таблицы, я хотел бы, чтобы он также заменил имя сервера базы данных и имя базы данных на значения из электронной таблицы.

Полная реализация не требуется, просто код для изменения соединения со значениями из листа будет достаточным, я должен иметь возможность заставить его работать оттуда.

Я попытался сделать что-то вроде этого:

 ActiveWorkbook
 .Connections("Job_Cost_Code_Transaction_Summary")
 .OLEDBConnection.Connection = "new connection string"

но это не сработает. Спасибо.

Ответ 1

Ответ на мой вопрос ниже.

Все остальные ответы в основном правильны и сосредоточены на изменении текущего соединения, но я хочу просто знать, как установить строку соединения в соединении.

Ошибка дошла до этого. Если вы посмотрите на мой скриншот, вы увидите, что строка подключения:

Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=ADCData_Doric;Data Source=doric-server5;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=LHOLDER-VM;Use Encryption for Data=False;Tag with column collation when possible=False

Я пытался установить эту строку с помощью ActiveWorkbook.Connections("Job_Cost_Code_Transaction_Summary").OLEDBConnection.Connection = "connection string"

Я получал сообщение об ошибке, когда я просто пытался назначить полную строку в Connection. Я смог MsgBox использовать текущую строку соединения с этим свойством, но не установил строку соединения, не получив ошибку.

С тех пор я обнаружил, что строка подключения должна иметь OLEDB;, добавленную к строке.

так что теперь это работает!!!

ActiveWorkbook.Connections("Job_Cost_Code_Transaction_Summary").OLEDBConnection.Connection = "OLEDB;Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=ADCData_Doric;Data Source=doric-server5;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=LHOLDER-VM;Use Encryption for Data=False;Tag with column collation when possible=False"

очень тонкий, но это была ошибка!

Ответ 2

Вы можете использовать функцию, которая принимает OLEDBConnection и параметры, которые будут обновляться как входные данные, и возвращает новую строку соединения. Это похоже на Jzz, но дает некоторую гибкость без необходимости редактировать строку соединения в коде VBA каждый раз, когда вы хотите ее изменить - в худшем случае вам придется добавлять новые параметры к функциям.

Function NewConnectionString(conTarget As OLEDBConnection, strCatalog As String, strDataSource As String) As String

    NewConnectionString = conTarget.Connection
    NewConnectionString = ReplaceParameter("Initial Catalog", strCatalog)
    NewConnectionString = ReplaceParameter("Data Source", strDataSource)

End Function

Function ReplaceParameter(strConnection As String, strParamName As String, strParamValue As String) As String

    'Find the start and end points of the parameter
    Dim intParamStart As Integer
    Dim intParamEnd As Integer
    intParamStart = InStr(1, strConnection, strParamName & "=")
    intParamEnd = InStr(intParamStart + 1, strConnection, ";")


    'Replace the parameter value
    Dim strConStart As String
    Dim strConEnd As String
    strConStart = Left(strConnection, intParamStart + Len(strParamName & "=") - 1)
    strConEnd = Right(strConnection, Len(strConnection) - intParamEnd + 1)

    ReplaceParameter = strConStart & strParamValue & strConEnd

End Function

Обратите внимание, что я изменил это из существующего кода, который я использовал для конкретного приложения, поэтому он частично протестирован и может нуждаться в некоторой настройке, прежде чем он полностью удовлетворит ваши потребности.

Обратите также внимание на то, что ему понадобится какой-то код вызова, который будет (если предположить, что новый каталог и источник данных хранятся в ячейках рабочего листа):

Sub UpdateConnection(strConnection As String, rngNewCatalog As Range, rngNewSource As Range)

    Dim conTarget As OLEDBConnection
    Set conTarget = ThisWorkbook.Connections.OLEDBConnection(strConnection)

    conTarget.Connection = NewConnectionString(conTarget, rngNewCatalog.Value, rngNewSource.Value)
    conTarget.Refresh

End Sub

Ответ 3

Я думаю, вы настолько близки к достижению того, что хотите.

Я смог изменить для ODBCConnection. Извините, что я не мог настроить OLEDBConnection для тестирования, вы можете изменить вхождения ODBCConnection на OLEDBConnection в вашем случае.

Попробуйте добавить 2 субмастера с модификацией и введите то, что вам нужно заменить в CommandText и Строке подключения. Примечание. Я установил .Refresh для обновления соединения, вам может не понадобиться, пока не потребуется фактическое обновление данных.

Вы можете изменить другие поля, используя ту же идею взлома, а затем присоединяйтесь к ней позже:

Private Sub ChangeConnectionString(sInitialCatalog As String, sDataSource As String)
    Dim sCon As String, oTmp As Variant, i As Long
    With ThisWorkbook.Connections("Job_Cost_Code_Transaction_Summary").ODBCConnection
        sCon = .Connection
        oTmp = Split(sCon, ";")
        For i = 0 To UBound(oTmp) - 1
            ' Look for Initial Catalog
            If InStr(1, oTmp(i), "Initial Catalog", vbTextCompare) = 1 Then
                oTmp(i) = "Initial Catalog=" & sInitialCatalog
            ' Look for Data Source
            ElseIf InStr(1, oTmp(i), "Data Source", vbTextCompare) = 1 Then
                oTmp(i) = "Data Source=" & sDataSource
            End If
        Next
        sCon = Join(oTmp, ";")
        .Connection = sCon
        .Refresh
    End With
End Sub

Private Sub ChangeCommanText(sCMD As String)
    With ThisWorkbook.Connections("Job_Cost_Code_Transaction_Summary").ODBCConnection
        .CommandText = sCMD
        .Refresh
    End With
End Sub

Ответ 4

Это должно сделать трюк:

Sub jzz()

Dim conn As Variant
Dim connectString As String

For Each conn In ActiveWorkbook.Connections
    connectString = conn.ODBCConnection.Connection
    connectString = Replace(connectString, "Catalog=ADCData_Doric", "Catalog=Whatever")
    connectString = Replace(connectString, "Data Source=doric-server5", "Data Source=Whatever")

    conn.ODBCConnection.Connection = connectString
Next conn


End Sub

Он перебирает каждое соединение в вашей книге и меняет строку соединения (в операциях замены 2).

Итак, чтобы изменить ваш пример:

ActiveWorkbook.Connections("Job_Cost_Code_Transaction_Summary").ODBCConnection.Connection = "new connection string"

Ответ 5

Я хотел бы внести свой небольшой вклад в эту старую тему. Если у вас много соединений в вашем файле Excel, и вы хотите изменить имя базы данных и сервер БД для всех них, вы также можете использовать следующий код:

Он выполняет итерацию по всем соединениям и извлекает строку подключения
Каждая строка соединения разделяется на массив строк
Он выполняет итерацию через массив, который ищет правильные значения соединения для изменения, другие не трогаются
Он перекомпонует массив в строку и зафиксирует изменение

Таким образом вам не нужно использовать replace и знать предыдущее значение, а остальная часть строки останется нетронутой. Кроме того, мы можем ссылаться на имя ячейки, поэтому вы можете иметь имена в файле Excel

Я надеюсь, что это поможет

Sub RelinkConnections()

Dim currConnValues() As String

For Each currConnection In ThisWorkbook.Connections
    currConnValues = Split(currConnection.OLEDBConnection.Connection, ";")
    For i = 0 To UBound(currConnValues)
        If (InStr(currConnValues(i), "Initial Catalog") <> 0) Then
            currConnValues(i) = "Initial Catalog=" + Range("DBName").value
        ElseIf (InStr(currConnValues(i), "Data Source") <> 0) Then
            currConnValues(i) = "Data Source=" + Range("DBServer").value
        End If
    Next
    currConnection.OLEDBConnection.Connection = Join(currConnValues, ";")
    currConnection.Refresh
Next

End Sub

Ответ 6

Я предполагаю, что вам необходимо сохранить одно и то же имя соединения? В противном случае было бы проще проигнорировать его и создать новое соединение.

Вы можете переименовать соединение и создать новый, используя имя:

ActiveWorkbook.Connections("Job_Cost_Code_Transaction_Summary").Name = "temp"
'or, more drastic:
'ActiveWorkbook.Connections("Job_Cost_Code_Transaction_Summary").Delete

ActiveWorkbook.Connections.Add "Job_Cost_Code_Transaction_Summary", _
    "a description", "new connection string", "command text" '+ ,command type

Впоследствии, Delete это соединение и восстановите старое соединение/имя. (Я не могу проверить это сам в настоящее время, поэтому осторожно протереть.)

В качестве альтернативы вы можете изменить текущие соединения SourceConnectionFile:

ActiveWorkbook.Connections("Job_Cost_Code_Transaction_Summary").OLEDBConnection.SourceConnectionFile = "..file location.."

Обычно это ссылается на файл .odc (Office Data Connection), сохраненный в вашей системе, содержащий сведения о соединении. Вы можете создать этот файл с панели управления окном.

Вы не указали, но файл .odc может быть тем, что использует ваше текущее соединение.

Опять же, я не могу протестировать эти предложения, поэтому вам следует изучить дальнейшие действия и принять некоторые меры предосторожности - чтобы вы не потеряли текущую информацию о соединении.