Измените встроенную строку подключения в макросе 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
Я бы хотел, чтобы обновление не только изменяло команду соединения, но и изменяло соединение, поскольку я хотел бы использовать его и с другой базой данных:
![enter image description here]()
Так же, как макрос заменяет параметры команды на значения из электронной таблицы, я хотел бы, чтобы он также заменил имя сервера базы данных и имя базы данных на значения из электронной таблицы.
Полная реализация не требуется, просто код для изменения соединения со значениями из листа будет достаточным, я должен иметь возможность заставить его работать оттуда.
Я попытался сделать что-то вроде этого:
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 может быть тем, что использует ваше текущее соединение.
Опять же, я не могу протестировать эти предложения, поэтому вам следует изучить дальнейшие действия и принять некоторые меры предосторожности - чтобы вы не потеряли текущую информацию о соединении.