I have been using the following method to query an MS Access database using Excel VBA for over a decade. All of a sudden yesterday it stopped working. I tried all of the following - reboot, move files to local machine, reinstall Office, a different PC, compact repair database, new database, new excel file, updating reference library (didn't see anything newer), and I've tried several other snippets of code found online.
If i relaunch excel it will work for 1-2 queries then throws the error:
Run-time error '-2147467259 (80004005)':
Unspecified error
It breaks on the line:
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
Here is the code I am running:
Public Function getRS(sSql As String) As Variant
Dim con As ADODB.Connection, rs As ADODB.Recordset
Dim AccessFile As String
Dim Rw As Long, Col As Long, c As Long
Dim MyField, Location As Range
'specify path to db
AccessFile = dbPath 'public variable
'On Error Resume Next
'Create the ADODB connection object.
Set con = CreateObject("ADODB.connection")
'Open the connection.
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
'Create the ADODB recordset object.
Set rs = CreateObject("ADODB.Recordset")
'Set thee cursor location.
rs.CursorLocation = 3 'adUseClient on early binding
rs.CursorType = 1 'adOpenKeyset on early binding
'On Error Resume Next
'Open the recordset.
rs.Open sSql, con
Set getRSOLD = rs
Set Location = Nothing
Set con = Nothing
Set rs = Nothing
End Function
Related
I lost my working code before I wrote to get data from .mdb file to Excel with VBA. Now, I did not find the true way to get data to excel. Here is the my code to import data;
Sub importAccessdata()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sQRY As String
Dim strFilePath As String
strFilePath = "D:\00 - DENEME\Deneme_Model_v0.mdb"
'Replace the ‘DatabaseFolder’ and ‘myDB.accdb’ with your DB path and DB name
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & strFilePath & ";"
sQRY = "SELECT * FROM Connectivity"
'Replace ‘tblData’ with your Access DB Table name or Query name from which you want to download the data
With rs
.CursorLocation = adUseClient
.Open Source:=sQRY, ActiveConnection:=cnn, CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, Options:=adCmdText
End With
Application.ScreenUpdating = False
Sheet1.Range(“A1”).CopyFromRecordset rs
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub
I got Run-Time Error 424 when I were running to code, I got error in "Sheet1.Range(“A1”).CopyFromRecordset rs" part of code.
I just want to get data from another Software output to use in Excel easily. My .mdb file can be seen here
Whats wrong I don't know. Also I have Sheet1 worksheet in my Excel file.
I have a problem whereby I have an excel vba macro which works perfectly on my local machine however when stored on a server crashes.
I have identified the point at which the macro crashes, and this is when the excel macro attempts to open the ADODB Recordset (Db is MS Access).
The folder structure in the code is identical to my desktop setup so I don't think this is the issue. Just seems to be when the excel file attempts to query the database when opening the ADODB recordset.
Any help much appreciated! If you need further info please let me know.
Thanks in advance!
EDIT:
Upon further investigation, I have verified opening and closing both the connection and recordset as working fine.
Its when I pass this query through as the source which causes excel to crash. Here is my code:
Dim DirectoryLocation As String
DirectoryLocation = Application.ActiveWorkbook.Path
Dim ConnString As String
ConnString = _
"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DirectoryLocation & "\Data\UK Sales.accdb;Persist Security Info=False;"
'Declare new database connection object
Dim DBConn As ADODB.Connection
'Set new database connection object
Set DBConn = New ADODB.Connection
'Declare new recordset object
Dim SalesData As ADODB.Recordset
'Set new recordset object
Set SalesData = New ADODB.Recordset
'Define connection string property of database connection object
DBConn.ConnectionString = ConnString
'Open database connection
DBConn.Open
'On Error GoTo CloseConnection
'Set parameter values for reporting
Dim Rep_Param As String
Rep_Param = Application.WorksheetFunction.VLookup(Worksheets("Dashboard").Range("C5"), Worksheets("Lookups").Range("H:I"), 2, 0)
Dim Rep_Option As String
Rep_Option = Worksheets("Dashboard").Range("C6").Value
'Get customer names for report and populate report
'------------------------Query---------------------'
Dim Cust_Billing_Qry As String
Cust_Billing_Qry = "SELECT DISTINCT Customer_Billing FROM Sales WHERE " & Rep_Param & "='" & Rep_Option & "'"
SalesData.Open Cust_Billing_Qry, DBConn
'On Error GoTo CloseRecordSet
Sheets("Revenue Analysis (Detail)").Range("C:C").ClearContents
Sheets("Revenue Analysis (Detail)").Range("C6").CopyFromRecordset SalesData
SalesData.Close
Any help much appreciated!
I have to create over 170 named ranges in Excel which I am trying to load into an Access table. Below is my code.
Sub Load_To_ALLL_TSD()
Dim strDatabasePath As String
Dim oApp As Access.Application
Dim PathOfworkbook As String
PathToDB = ThisWorkbook.Path
strDatabasePath = PathToDB & "\RAROC.accdb"
Set oApp = CreateObject("Access.Application")
'Set db = Application.CurrentProject
oApp.Visible = True
oApp.OpenCurrentDatabase strDatabasePath
Set db = CurrentDb()
Set rs = db.OpenRecordset("ALLL_TSD", dbOpenTable)
With oApp
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("TSD_Base_Rate_Received") = Range("TSD_Base_Rate_Received").Value
.Fields("TSD_Base_Rate_Received_Input") = Range("TSD_Base_Rate_Received_Input").Value
.Fields("TSD_Calculated_RAROC") = Range("TSD_Calculated_RAROC").Value
.Fields("TSD_Capital_Factor") = Range("TSD_Capital_Factor").Value
' etc, etc, lot more fields and named ranges here
' add more fields if necessary...
.Update ' stores the new record
End With
End With
Set oApp = Nothing
MsgBox ("Done! All Data saved to RAROC database!!")
End Sub
I'm getting some weird errors! If I run the code using F8, it works fine. If I click a button to fire the code, sometimes it works and sometimes it doesn't work. I has errored out on several different lines.
Once it threw an error here:
Set rs = db.OpenRecordset("ALLL_TSD", dbOpenTable)
Error reads 'object variable or with block not set'
Once it said 'Microsoft Access has stopped working' and it threw an error on this line.
.Fields("TSD_Base_Rate_Received_Input") = Range("TSD_Base_Rate_Received_Input").Value
I've seen some other weird things too.
I have a reference set to both:
Microsoft DAO 3.6 Object Library
Microsoft Access 14.0 Object Library
It almost seems like I'm establishing a connection to Access and then almost immediately I lost the connection, somehow.
Finally, I have no Forms or Reports, and the DB is not split. I have just one single table in there now, which I am trying to write to. What can I try to resolve this?
Here's a basic example without using Access.
Needs a reference to Microsoft ActiveX Data Objects 2.x Library
Sub Tester()
Dim con As New ADODB.Connection, rs As New ADODB.Recordset
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source = " & ThisWorkbook.Path & "\RAROC.accdb"
'get an empty recordset to add new records to
rs.Open "select * from [ALLL_TSD] where false", con, _
adOpenDynamic, adLockBatchOptimistic
With rs
.AddNew
.Fields("TSD_Base_Rate_Received") = Range("TSD_Base_Rate_Received").Value
.Fields("TSD_Base_Rate_Received_Input") = Range("TSD_Base_Rate_Received_Input").Value
.Fields("TSD_Calculated_RAROC") = Range("TSD_Calculated_RAROC").Value
.Fields("TSD_Capital_Factor") = Range("TSD_Capital_Factor").Value
'etc...
.UpdateBatch '<< EDIT
.Close
End With
con.Close
End Sub
I am new to vba and I am using vba script to connect to database from excel and get the records. I have written the following script for that.I am getting a run time error '-2147467259(80004005)':Unspecified error.
How to resolve this error. See the error screen shot.
Sub Ora_Connection()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim query As String
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
'--- Replace below highlighted names with the corresponding values
strCon = "Driver={Microsoft ODBC for Oracle}; " & _
"CONNECTSTRING=(DESCRIPTION=" & _
"(ADDRESS=(PROTOCOL=TCP)" & _
"(HOST=host_name)(PORT=1521))" & _
"(CONNECT_DATA=(SERVICE_NAME=service_name))); uid=id; pwd=pw;"
'--- Open the above connection string.
con.Open (strCon)
'--- Now connection is open and you can use queries to execute them.
'--- It will be open till you close the connection
query = "select * from security.forms"
Set rs = con.Execute(query)
For i = 0 To rs.Fields.Count - 1
Sheet1.Cells(1, i + 1).Value = rs.Fields(i).Value
Next
con.Close
End Sub
Error screen shot:
Had you tried to use the open method of your RecordSet instance? Maybe it will give you another error that will be more helpful.
Dim connection As New ADODB.connection
Dim rst As New ADODB.Recordset
Dim query As String
connection.ConnectionString = CONNECTION_STRING
connection.Open
rst.Open query, connection, adOpenKeyset, adLockOptimistic
do while not rst.EOF
rst.MoveNext
loop
connection.Close
I had the exact same problem and it was tough to find an answer since most posts on this issue are unanswered.
I solved it by using another Oracle driver. Instead of Microsoft ODBC for Oracle try using the Oracle in OraClient11g_home1 driver. Hope this helps
Please add the reference 'Microsoft ActiveX Data Objects 2.8 Library'
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