I have an Excel document that has a macro which when run will modify a CommandText of that connection to pass in parameters from the Excel spreadsheet, like so:
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
I would like the refresh to not only modify the connection command but also modify the connection as I would like to use it with a different database also:
Just like the macro replaces the command parameters with values from the spreadsheet I would like it to also replace the database server name and database name from values from the spreadsheet.
A complete implementation is not required, just the code to modify the connection with values from the sheet will be sufficient, I should be able to get it working from there.
I tried to do something like this:
ActiveWorkbook
.Connections("Job_Cost_Code_Transaction_Summary")
.OLEDBConnection.Connection = "new connection string"
but that does not work. Thanks.
The answer to my question is below.
All of the other answers are mostly correct and focus on modifying the current connection, but I want just wanting to know how to set the connection string on the connection.
The bug came down to this. If you look at my screenshot you will see that the connection string was:
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
I was trying to set that string with ActiveWorkbook.Connections("Job_Cost_Code_Transaction_Summary").OLEDBConnection.Connection = "connection string"
I was getting an error when i was simply trying to assign the full string to the Connection. I was able to MsgBox the current connection string with that property but not set the connection string back without getting the error.
I have since found that the connection string needs to have OLEDB; prepended to the string.
so this now works!!!
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"
very subtle but that was the bug!
I think you are so close to achieve what you want.
I was able to change for ODBCConnection. Sorry that I couldn't setup OLEDBConnection to test, you can change occurrences of ODBCConnection to OLEDBConnection in your case.
Try add this 2 subs with modification, and throw in what you need to replace in the CommandText and Connection String. Note I put .Refresh to update the connection, you may not need until actual data refresh is needed.
You can change other fields using the same idea of breaking things up then Join it later:
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
You could use a function that takes the OLEDBConnection and the parameters to be updated as inputs, and returns the new connection string. It's similar to Jzz's answer but allows some flexibility without having to edit the connection string within the VBA code each time you want to change it - at worst you'd have to add new parameters to the functions.
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
Note that I have modified this from existing code that I have used for a particular application, so it's partly tested and might need some tweaking before it totally meets your needs.
Note as well that it'll need some kind of calling code as well, which would be (assuming that the new catalog and data source are stored in worksheet cells):
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
I would like to give my small contribute here to this old topic.
If you have many connections in your Excel file, and you want to change the DB name and DB server for all of them, you can use the following code as well:
It iterates through all connections and extracts the connection string
Each connection string is split into an array of strings
It iterates through the array searching for the right connection values to modify, the others are not touched
The it recompose the array into the string and commit the change
This way you don't need to use replace and to know the previous value, and the rest of the string will remain intact.
Also, we can refer to a cell name, so you can have names in your Excel file
I hope it can help
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
This should do the trick:
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
It loops every connection in your workbook and change the Connection String (in the 2 replace statements).
So to modify your example:
ActiveWorkbook.Connections("Job_Cost_Code_Transaction_Summary").ODBCConnection.Connection = "new connection string"
I assume it is necessary for your to keep the same connection-name? Otherwise, it would be simplest to ignore it and create a new Connection.
You might rename the connection, and create a new one using the name:
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
Afterwards, Delete this connection and reinstate the old connection/name. (I am unable to test this myself currently, so tread carefully.)
Alternatively, you might change the current connections SourceConnectionFile:
ActiveWorkbook.Connections("Job_Cost_Code_Transaction_Summary").OLEDBConnection.SourceConnectionFile = "..file location.."
This typically references an .odc file (Office Data Connection) saved on your system that contains the connection details. You can create this file from the Window's Control Panel.
You haven't specified, but an .odc file may be what your current connection is using.
Again, I am unable to test these suggestions, so you should investigate further and take some precautions - so that you won't risk losing the current connection details.
I am trying to add an attachment that is found within the current database to a control on the current form:
I have a form that contains both a combo box ("cmb") and an attachment control ("attachctrl").
The user shall be able to choose a value in the combo box and the corresponding attachment shall be added to the attachment control.
I am using an SQL query to get the recordset from the table containing the attachments. I am able to get some data (e.g. the file name, type, URL and the data).
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim intResult As Integer
Dim strSQL As String
Dim existingEntry
Set db = CurrentDb
strSQL = "SELECT [Analysis1] FROM [tblAnalysis] WHERE [ID] = '" & Me.cmb.Value & "'"
Set rs = db.OpenRecordset(strSQL)
I can then access the fields within the recordset as:
fileName = rs(0).Value.fileName
fileType = rs(0).Value.FileType
fileData = rs(0).Value.FileData
However, how can I add the data to the corresponding fields of the attachment control?
When I try to manually write the data to the fields I get an error message, that I am not allowed to write to the field in question:
Me.attachctrl.fileName = rs(0).Value.fileName 'not working
Me.attachctrl.FileType = rs(0).Value.fileName 'not working
Me.attachctrl.FileURL = rs(0).Value.FileURL 'not working
Also: I can't find a field that would take the actual data of the attachment. Where do I assign the data to?
I want to show the results of a call to a webservice (several rows) in ms-Access. To do this I created a form with the defaultView = 1 (= continuous form).
Now I wonder if I can use show results from the webservice directly in my form. This means without creating a table which I then select with the recordsource-property.
Is there a way to show data a continuous-form in MS-Access without using a table?
I tried to set the recordset by myself like this:
Private Sub Form_Load()
Set m_Dataset = CurrentDb.OpenRecordset("Test", RecordsetTypeEnum.dbOpenDynamic)
Call m_Dataset.AddNew
m_Dataset("OutOfThinAir") = "Hallo"
Set Me.Recordset = m_Dataset
End Sub
But OpenRecordset raises the error "invalid argument".
I also thought of setting the recordsource to a select statement without using a table name (In oracle this would be "Select ... from dual") but I did not find a working statement. "SELECT 1 from dual;" does definitely not work.
Yes, but you'd need to use an ADODB recordset, not a DAO one.
E.g.
Dim m_Dataset As New ADODB.Recordset
m_Dataset.Fields.Append "OutOfThinAir",adVarWChar, 6, adFldUpdatable
m_Dataset.Open
m_Dataset.AddNew 'No call!
m_Dataset("OutOfThinAir") = "Hallo"
Set Me.Recordset = m_Dataset
With the help of Erik A I I figured out a solution which works:
Private Sub Form_Load()
Dim rstADO As ADODB.Recordset
Set rstADO = New ADODB.Recordset
rstADO.Fields.Append "OutOfThinAir", adVarChar, 100, adFldMayBeNull
rstADO.LockType = adLockOptimistic
rstADO.Open
rstADO.Addnew
rstADO.Fields("OutOfThinAir") = "Hello"
rstADO.Update
rstADO.Addnew
rstADO.Fields("OutOfThinAir") = "Du"
rstADO.Update
Set Me.Recordset = rstADO
End Sub
Btw I had to add "Microsoft ActiveX Data Objects 6.1 Library" as a reference in order to use the constants and "ADODB.Recordset" as a variabletype.
I am trying to export a SQL table result into Excel using blue prism. Currently it is done by exporting SQL results to collection and then collection to Excel. This is taking a longer time (10 mins) to export ~20K records. This is because the VBO uses for each loop.
I am trying to use some customized VB code to load the collection into excel using bulk update.
Can anyone help me on this?
I tried the below code but its not working
' Get to the cell
Dim ws As Object = GetWorksheet(handle, workbookname, worksheetname)
Dim origin As Object = ws.Range(cellref, cellref)
Dim cell As Object = origin
Dim colInd As Integer = 0, rowCount As Integer, rowInd As Integer = 0 ' Offsets from the origin cell
' Deal with the column names first
If includecolnames Then
For Each col As DataColumn In Collection.Columns
Try
cell = origin.Offset(rowInd, colInd)
Catch ex As Exception ' Hit the edge.
Exit For
End Try
SetProperty(cell, "Value", col.ColumnName)
colInd += 1
Next
rowInd += 1
End If
rowCount = Collection.Rows.Count
xlRange = ws.Range(cellref & ":H" & rowCount)
xlRange.Value = Collection
Error that I am getting is: Member not found. (Exception from HRESULT: 0x80020003 (DISP_E_MEMBERNOTFOUND))
I think that you're looking for this function of WorkSheet:
ws.SetRangeValues(RowIndex, ColumnIndex, Array(, ))
Just build two-dimensional array in memory based on your SQL data and call this once. It will fill the data from selected RowIndex and ColumnIndex all at once much faster then iterative way.
the way youre approaching this seems not very efficient, grabbing results from one place to put into another and then into another. here are two other alternatives you can try?
Automate command through CMD
sqlcmd -S . -d AzureDemo50 -E -s, -W -Q "SELECT * FROM dbo04.ExcelTest" > ExcelTest.csv
something like this more info (https://www.excel-sql-server.com/sql-server-export-to-excel-using-bcp-sqlcmd-csv.htm)
here you can run a command through cmd line with blue prism and then push the value where you want it to go without having to put the memory in blue prism at all.
Use a db object like OLEDB to parse a command straight into the DB to push the values into excel.
in both of these options the data never gets into Blueprism so of note, you dont get the opportunity to save, alter etc on the data in blueprism however it is much faster to operate.
test: made a db with 20k rows 5 columns data export with above cmd took 1.7 seconds to execute pluse extra 1/2 seconds for blueprism running it so 3-5 seconds total with smaller memory allocation that your current implementation.
is this something like you were looking for?
Thanks for your answers. I have added a new page called Write Collection - Fast and added code stage in Blue Prism MS Excel VBO. Pasted the below code
Dim ws As Object = GetWorksheet(handle, workbookname, worksheetname)
Dim sqlCon As New ADODB.Connection
Dim recordSet As New ADODB.Recordset
Dim iCol As Integer
sqlCon = New ADODB.Connection
sqlCon.ConnectionString = "driver={SQL Server};server=xxx\SQLEXPRESS;uid=zzzz;pwd=yyyy;database=testData"
sqlCon.ConnectionTimeout = 30
sqlCon.Open
recordSet.Open (SQL, sqlCon)
For iCol = 0 To recordSet.Fields.Count - 1
ws.Cells(1, iCol + 1).Value = recordSet.Fields(iCol).Name
Next
ws.Range("A2").CopyFromRecordset(recordSet)
recordSet.Close
sqlCon.Close
I am trying to create some custom buttons in Outlook that interact with a table contained within an Access database. So far I have my buttons working in Outlook, running code that instantiates a custom data access class which in turn handles opening and closing the connection to the database. So far as I can tell, this much works.
However from this class I cannot even perform a simple select query. Can anyone help me understand why the code below might not work? I always end out with a recordset that has no rows but if I run the same sql using the Access query designer it works fine.
Public Function GetJobID(ByVal xEmailID As String) As Integer
'Returns the JobID associated with a given EmailID from the email link table.
'Returns a fail constant if no link exists.
Dim rs As ADODB.Recordset
Dim sql As String
'Exit if not connected.
'Cast to boolean because VBA doesn't recognise connection state integer as boolean.
If Not CBool(mConn.State) Then
GetJobID = RESULT_FAIL_INTEGER
Exit Function
End If
sql = "SELECT [JobID] FROM [EMAIL_LINK_TABLE] WHERE [EmailID]='xEmailID'"
sql = Replace(sql, "EMAIL_LINK_TABLE", EMAIL_LINK_TABLE)
sql = Replace(sql, "xEmailID", xEmailID)
On Error Resume Next
Set rs = mConn.Execute(sql)
If rs.RecordCount > 0 Then
GetJobID = rs(1).Value
Else
GetJobID = RESULT_FAIL_INTEGER
End If
End Function
I see you've tracked down the issue to .RecordCount returning -1.
This is standard behavior for dynamic cursors, from the docs:
The cursor type of the Recordset object affects whether the number of records can be determined. The RecordCount property will return -1 for a forward-only cursor; the actual count for a static or keyset cursor; and either -1 or the actual count for a dynamic cursor, depending on the data source.
Of course, you can modify your code to use a static cursor, but that will impact performance. Instead, to test if there are records in your recordset, use .EOF (a method returning a boolean to indicate if the recordset is currently at the end of the file). That will save your code from having to load all records, when only loading the first one is required:
Public Function GetJobID(ByVal xEmailID As String) As Integer
'Returns the JobID associated with a given EmailID from the email link table.
'Returns a fail constant if no link exists.
Dim rs As ADODB.Recordset
Dim sql As String
'Exit if not connected.
'Cast to boolean because VBA doesn't recognise connection state integer as boolean.
If Not CBool(mConn.State) Then
GetJobID = RESULT_FAIL_INTEGER
Exit Function
End If
sql = "SELECT [JobID] FROM [EMAIL_LINK_TABLE] WHERE [EmailID]='xEmailID'"
sql = Replace(sql, "EMAIL_LINK_TABLE", EMAIL_LINK_TABLE)
sql = Replace(sql, "xEmailID", xEmailID)
On Error Resume Next
Set rs = mConn.Execute(sql)
If Not rs.EOF Then
GetJobID = rs(0).Value
Else
GetJobID = RESULT_FAIL_INTEGER
End If
End Function