Excel VBA Executing Access Query that Links to Oracle - excel

Let me start of by saying I am new to both this site as well as VBA so please bear with me. Thank you in advance for your help.
I have a VBA function that runs an existing query from Access. Some of the tables being queried are stored in an Oracle database that require a user specific password access. Right now, a sub that I wrote to automate a report calls this function 7 times and requires the user to input their Oracle password each time the function is called (it also stops the sub and gives an error message if they type in the password incorrectly which I see as a likely event if they need to do it 7 times). The code works but I would like to find a way to have the code ask for the password once and be done with it. All of the solutions I have found involve connecting to and querying Oracle directly which requires very complicated SQL coding that I am by no means capable of writing.
I am also having an issue where the columns show up in the excel sheet in a different order than they do in Access for some of the queries. This seems to be consistent so it isn't to big of a problem but I would like to know how to prevent this to prevent any future issues.
Here is the code for the function I am currently using. Any insight would be greatly appreciated!
Option Explicit
'Single Argument "qryName" as string. Runs access qry and copys recordset to active sheet.
Function AccessQueryPull(qryName As String)
'Declare variables
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
'open the connection to the access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=filePath.accdb;"
'format the command to run the query
Dim cmd As New ADODB.Command
cmd.CommandType = adCmdStoredProc
cmd.CommandText = qryName
cmd.ActiveConnection = cn
'execute the query
Set rs = New ADODB.Recordset
Set rs = cmd.Execute()
'copy data to excel sheet
ActiveSheet.Cells(2, 1).CopyFromRecordset rs
'Cleanup
rs.Close
Set rs = Nothing

The reason you are prompted each time for Oracle credentials is that you create a fresh, new connection to MS Access each time the function is called.
Simply persist the MS Access connection by connecting once in the Sub that calls function and pass connection object as parameter. In this way, any connection error is caught in the parent routine. As for column order simply declare the columns in the needed order in SQL statement.
Sub RunQueries()
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
'open the connection to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=filePath.accdb;"
Call AccessQueryPull(cn, "SELECT Col1, Col2, Col3 FROM Qry1") ' AND OTHER 6 CALLS
cn.Close
Set cn = Nothing
End Sub
Function AccessQueryPull(accConn As ADODB.Connection, qryName As String)
'format the command to run the query
Dim cmd As New ADODB.Command
cmd.CommandType = adCmdStoredProc
cmd.CommandText = qryName
cmd.ActiveConnection = accConn
'execute the query
Set rs = New ADODB.Recordset
Set rs = cmd.Execute()
'copy data to excel sheet
ActiveSheet.Cells(2, 1).CopyFromRecordset rs
'Cleanup
rs.Close
Set rs = Nothing: Set cmd = Nothing
End Function

Related

Unable to run Access query through ADODB connection in Excel

I am trying to paste in the results of an access query to a sheet in Excel.
When I run the following code, nothing happens. No errors or warnings, just nothing ever gets pasted in. However, when I run the same code, but use a table instead of a query name, it successfully pulls in the table. But when I replace it with a query name, it returns nothing.
In the past I have done the same thing but instead of calling the query name, I have stored the SQL query as a string within the macro and called the query by referencing the string. I tried that and that did not work in this case.
The query I am trying to pull references other queries as tables, and I think this is why I am having issues. Like I said, I have pulled data from Access with this code many times before but have only been able to do so when I am referencing tables only, and not queries.
Dim Con As ADODB.Connection
Set Con = New ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim iCols As Integer
Set Con = New ADODB.Connection
With Con
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open AccessDBPath
End With
Set rs = New ADODB.Recordset
rs.Open "query1", Con
Sheets("NAHV").Range("E2").CopyFromRecordset rs
I have tried replacing the rs.Open line with the Execute command:
Set rs = Con.Execute("query1")
and this also did not work.
I have also tried replacing the full block with
Dim cn As Object, rs As Object
Dim myFile As String: myFile = AccessDBPath
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & myFile & ";"
.Open
End With
Set rs = cn.Execute("query1")
Sheets("NAHV").Range("E2").CopyFromRecordset rs
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
and this did not work either.

Performance issue with access to excel vba

I need to get data from Access to excel vba, I use ADODB.
My problem is that although the database is relatively small and query results 30-40 records only, the process gets stuck either with the ".open" or with "copyfromrecordset" line and takes 40-50 secs to display the records.
This is my code.
I made some tests with different cursor types and locktypes with no result. The query is working executed directly from access and I have no issue when the connection points locally to my PC. I am on office 365. I referenced the activex data objects 2.8 library.
Sub loadTestDisplay2()
Dim myConnectiom As ADODB.Connection
Dim myRS As ADODB.Recordset
Const conStringNet As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=\\ourserver-f04\COE-Shared\Data Tool\Access\adsLoadTest.accdb; Persist Security Info=False;"
Dim sql As String
sql = "SELECT * FROM tblLoad where user is Null"
Set myConnection = New ADODB.Connection
Set myRS = New ADODB.Recordset
myConnection.ConnectionString = conStringNet
myConnection.Open
With myRS
.ActiveConnection = conStringNet
.Source = sql
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
Sheets.Add
Range("A2").CopyFromRecordset myRS
myRS.Close
myConnection.Close
End Sub

Get specific data(query) from Oracle into excel

I want to load specific data(query) from Oracle database into excel. I am able to achieve it through external connections, (Mircosoft Data Access - OLE DB Provider for Oracle), but all of the table is loaded. This was by hit and try. I am not aware what OLE DB is.
Is it possible to load specific data using that method.
How can I load the same from VBA, I have read many sources, blogs but none are lucid and comprehensive. Can somebody please explain for a newbie. Or refer to me some book/source.
This function will connect to an Oracle Database using ADODB. Make sure to include Microsoft ActiveX Data Objects 2.8 as a reference. You can configure the connectingstring to suit your needs if there are admin privileges.
It will store your database into a variant.
Function ConToDataBase(DBPath As String) As Variant
Dim Con As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim SQL As String
SQL = "SELECT * FROM TableName"
Set Con = New ADODB.Connection
With Con
.ConnectionString = "Provider=OraOLEDB.Oracle;Data source=" & DBPath & ";UserID=;Password:=;"
.Open
End With
Set Rs = New ADODB.Recordset
Rs.Open SQL, Con
Dim Var As Variant
Var = Rs.GetRows
ConToDataBase = Var
Set Rs = Nothing
Con.Close
End Function

Moving an Excel Worksheet to Access with VBA error

Hello I am trying to move an Excel worksheet to an Access database, both of which have identical field names. The Code is written in Excel.
The user inputs several form fields and upon clicking finish, a seperate worksheet is updated. Then, the update Access subroutine is called to update the database with the contents of the sheet. However I continue to receive the following error:
Run-time error '-2147417848 (80010108)':
Automation error
The object invoked has disconnected from its clients.
I googled the error and can't quite see what is going on. Here is my code:
Sub Update_Access_fromExcel()
' exports data from the active worksheet to a table in an Access database
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' Connect to Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & "Data Source=D:\Tool_Database\Tool_Database.mdb;"
' open the recordset
Set rs = New ADODB.Recordset
rs.Open "Project_Names", cn, adOpenKeyset, adLockOptimistic, adCmdTable
r = 2
Do Until IsEmpty(Worksheets("NewProj").Cells(r, 1))
With rs
.AddNew
.Fields("Proj_Name") = Worksheets("NewProj").Cells(r, 1).Value
.Update
End With
r = r + 1
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Also, is there a way I could just add the new info to the end of the Access database?
Thanks for your help.

VBA - Create ADODB.Recordset from the contents of a spreadsheet

I am working on an Excel application that queries a SQL database. The queries can take a long time to run (20-40 min). If I've miss-coded something it can take a long time to error or reach a break point. I can save the results to a sheet fine, it's when I am working with the record sets that things can blow up.
Is there a way to load the data into a ADODB.Recordset when I'm debugging to skip querying the database (after the first time)?
Would I use something like this?
Query Excel worksheet in MS-Access VBA (using ADODB recordset)
I had to install the MDAC to get the msado15.dll and once I had it I added a reference to it from (on Win7 64bit):
C:\Program Files (x86)\Common Files\System\ado\msado15.dll
Then I created a function to return an ADODB.Recordset object by passing in a sheet name that exists in the currently active workbook. Here's the code for any others if they need it, including a Test() Sub to see if it works:
Public Function RecordSetFromSheet(sheetName As String)
Dim rst As New ADODB.Recordset
Dim cnx As New ADODB.Connection
Dim cmd As New ADODB.Command
'setup the connection
'[HDR=Yes] means the Field names are in the first row
With cnx
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source='" & ThisWorkbook.FullName & "'; " & "Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
.Open
End With
'setup the command
Set cmd.ActiveConnection = cnx
cmd.CommandType = adCmdText
cmd.CommandText = "SELECT * FROM [" & sheetName & "$]"
rst.CursorLocation = adUseClient
rst.CursorType = adOpenDynamic
rst.LockType = adLockOptimistic
'open the connection
rst.Open cmd
'disconnect the recordset
Set rst.ActiveConnection = Nothing
'cleanup
If CBool(cmd.State And adStateOpen) = True Then
Set cmd = Nothing
End If
If CBool(cnx.State And adStateOpen) = True Then cnx.Close
Set cnx = Nothing
'"return" the recordset object
Set RecordSetFromSheet = rst
End Function
Public Sub Test()
Dim rstData As ADODB.Recordset
Set rstData = RecordSetFromSheet("Sheet1")
Sheets("Sheet2").Range("A1").CopyFromRecordset rstData
End Sub
The Sheet1 data:
Field1 Field2 Field3
Red A 1
Blue B 2
Green C 3
What should be copied to Sheet2:
Red A 1
Blue B 2
Green C 3
This is saving me a HUGE amount of time from querying against SQL every time I want to make a change and test it out...
--Robert
Easiest would be to use rs.Save "filename" and rs.Open "filename" to serialize client-side recordsets to files.
Another alternative to get a Recordset from a Range would be to create and XMLDocument from the target Range and open the Recordset from that document using the Range.Value() property.
' Creates XML document from the target range and then opens a recordset from the XML doc.
' #ref Microsoft ActiveX Data Objects 6.1 Library
' #ref Microsoft XML, v6.0
Public Function RecordsetFromRange(ByRef target As Range) As Recordset
' Create XML Document from the target range.
Dim doc As MSXML2.DOMDocument
Set doc = New MSXML2.DOMDocument
doc.LoadXML target.Value(xlRangeValueMSPersistXML)
' Open the recordset from the XML Doc.
Set RecordsetFromRange = New ADODB.Recordset
RecordsetFromRange.Open doc
End Function
Make sure to set a reference to both Microsoft ActiveX Data Objects 6.1 Library and Microsoft XML, v6.0 if you want to use the example above. You could also change this function to late binding if so desired.
Example call
' Sample of using `RecordsetFromRange`
' #author Robert Todar <robert#roberttodar.com>
Private Sub testRecordsetFromRange()
' Test call to get rs from Range.
Dim rs As Recordset
Set rs = RecordsetFromRange(Range("A1").CurrentRegion)
' Loop all rows in the recordset
rs.MoveFirst
Do While Not rs.EOF And Not rs.BOF
' Sample if the fields `Name` and `ID` existed in the rs.
' Debug.Print rs.Fields("Name"), rs.Fields("ID")
' Move to the next row in the recordset
rs.MoveNext
Loop
End Sub

Resources