I am struggling to find relevant information on the
'run-time error '-2147418113 (8000ffff)' - Catastrophic Failure'
I am experiencing.
Sub GenerateAIA_Click()
Dim SQL_query, SQL_syntax, DB_path, setting_conn As String
Dim conn As New ADODB.Connection
Dim query_rslt As New ADODB.Recordset
Dim mth, mth_yr As Variant
Dim dt As Date
Dim i, bol As Integer
Dim temp1, temp2 As Variant
dt = Sheets("Main").Range("C4")
mth_yr = MonthName(Month(Sheets("Main").Range("I12")), False) & " " & Year(Sheets("Main").Range("I12"))
ThisWorkbook.Sheets("AIA").Select
DB_path = ThisWorkbook.FullName 'Refering the same workbook as Data Source
setting_conn = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DB_path & ";HDR=Yes';"
conn.Open setting_conn
SQL_syntax = "SELECT * FROM [Setup$]" 'Your SQL Statement (Table Name= Sheet Name=[Sheet1$])
query_rslt.Open SQL_syntax, conn
I have also noticed that this error is shown on the line
conn.Open setting_conn
I use excel 2016 and also my file format .xlsm
Anyone have idea why is this happening?
It seems your connection string has a problem.
Here's how I got it to work:
(First make sure to add a reference to the Microsoft Active-X Data Objects Library)
Sub test()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\PC\test.xlsm;Extended Properties=""Excel 12.0 Macro;HDR=NO"";"
conn.Open
rs.Open "SELECT * FROM [Sheet1$]", conn
If Not rs.EOF Then
MsgBox rs(0) ' display the value of the first field in the first row
Else
MsgBox "No records found."
End If
rs.Close
conn.Close
End Sub
So take my example, change the filename to your XLSM file, and the sheet name to your sheet name (with a $ added to the end of it)
If your sheet has header names in the first now, use HDR=Yes, and if not, HDR=No
or you can change display resolution for your monitor
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.
How do I or can I assign an ADO connection to a pivot tables data source in excel 2010? I want to do this as a workaround for excel not being able to have password protected files connected without them being open.
I will include two code snippets below.
Code to iterate over all pivot tables to change data source to an existing connection
Sub changeConnection()
Dim pTable As Variant
Dim sheet As Variant
Dim workBookName As String
workBookName = "filename.xlsm"
For Each sheet In Workbooks(workBookName).Worksheets
For Each pTable In sheet.PivotTables
pTable.changeConnection Workbooks(workBookName ).Connections("connection name")
Next pTable
Next sheet
End Sub
Code to create an ADO connection on a password protected file.
Public Function readFile()
Dim xl As Object
Dim conn As New ADODB.connection
Dim recSet As ADODB.Recordset
Dim conString As String
Dim wkbName As String
Dim SQL As String
Dim DBPath As String
'Path to excel file
DBPath = "path\to\file.xlsm"
Set xl = GetObject(DBPath)
'Name of table
wkbName = "[IS$]"
conString = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"
'Query
SQL = "select * from " & wkbName
'Open connection
conn.Open conString
'Itterate over record set
Set recSet = New ADODB.Recordset
recSet.Open SQL, conn
'Print out col1 from table
Do Until recSet.EOF
'process your data here
Debug.Print recSet!ISData
recSet.MoveNext
Loop
End Function
Any suggestions would be awesome on how I could try this. I don't want to use open workbook as this is meant to be used by several people.
Thanks in advance!!!
My below code shows no error, when run, but I don't know how to extract required/particular field values into my excel sheet.
Sub getdatafromaccesstoanarray()
Dim cn As Object 'Connection
Dim rs As Object 'Recordset
Dim vAry() As Variant 'Variant Array
Dim dbPath As String 'Database Path
Dim dbName As String 'Database Name
Dim txt As String
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
dbPath = ThisWorkbook.Path & "\"
dbName = "NewDB.accdb"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & dbPath & dbName & ";"
rs.Open "SELECT * FROM BILLDETAILS WHERE BILLDETAILS.SN_AUTO =100;", cn
vAry = rs.GetRows()
'now when the data is copied to my array how can i paste specific values from this data to
'cells in my excel sheet
'like
'on active sheet
'[a1] = vAry(value1)
'[a2] = vAry(value3)
'[a3] = vAry(value8)
'and other values like wise
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
If there any other way to do this then please let me know.
Thanks!
If you just want to copy the recordset into the sheet you can use the CopyFromRecordset method to dump the table into the sheet by specifying the top left corner:
Range("a1").copyfromrecordset rs
If you want to put specific fields in specific positions you can loop
Do While not rs.eof
range("a2")=rs(0)
range("b2")=rs(1)
'etc....
rs.movenext
Loop
I am trying to create a Vlookup using VBA in Excel.
I want to look up 'column1' on 'Sheet1' against 'column2' on 'Sheet2'
I also want to return multiple columns on Sheet 1 - 3,4,5,6 (from Sheet2)
Can you help me with this?
I think it would be easier and much faster to use sql query table, instead of vlookup.
Below I present code with two macros:
1) First call second macro that makes query table you want.
2) Second is a subprocerude that executes indicated ado sql query statement (indicated in sql_stmt string) and pastes it to indicated sheet and range.
In sql_stmt string definiton you must change "sheetX_columnXheader" to adequate columns headers.
If you want to get results in different sheet you need to call sql_query subprocedure with different second parameter.
If you want to get other columns as a result or match data on different columns you must change sql_stmt string to adequate ado sql query statement.
Option Explicit
Sub matching_data()
Dim sqlstmt As String
On Error GoTo error
Application.ScreenUpdating = False
sqlstmt = "SELECT a.[sheet1_column1header], b.[sheet2_column2header], b.[sheet2_column3header], b.[sheet4_column2header] FROM [sheet1$] a LEFT JOIN [sheet2$] b ON a.[sheet1_column1header]=b.[sheet2_column1header]"
sql_query sqlstmt, "new_sheet", "A1"
'ending
Application.ScreenUpdating = True
MsgBox ("Finished")
Exit Sub
'error message
error:
MsgBox ("Unknown error")
Application.ScreenUpdating = True
End Sub
'subprocedure that executes ado sql query statement and pastes results in indicated range and sheet
Public Sub sql_query(ByVal sqlstmt As String, ByVal sheet_name As String, ByVal target1 As String)
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim connstring As String
Dim qt As QueryTable
Dim tw_path As String
Dim is_name As Boolean
Dim sh As Worksheet
On Error GoTo error
'''adding sheet if there is no sheet with indicated name
is_name = False
For Each sh In ThisWorkbook.Worksheets
If sh.Name = sheet_name Then is_name = True
Next
If is_name = False Then ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = sheet_name
''' connection
tw_path = ThisWorkbook.path & "\" & ThisWorkbook.Name
connstring = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & tw_path & ";Extended Properties=Excel 8.0;Persist Security Info=False"
''' making database
Set conn = New ADODB.Connection
conn.ConnectionString = connstring
conn.Open
'''executing statement
Set rs = New ADODB.Recordset
rs.Source = sqlstmt
rs.ActiveConnection = conn
rs.Open
'''saving results
ThisWorkbook.Worksheets(sheet_name).Activate
Set qt = Worksheets(sheet_name).QueryTables.Add(Connection:=rs, Destination:=Range(target1))
qt.Refresh
'''ending
ending:
If rs.State <> adStateClosed Then rs.Close
conn.Close
If Not rs Is Nothing Then Set rs = Nothing
If Not conn Is Nothing Then Set conn = Nothing
Set qt = Nothing
Exit Sub
'
error:
MsgBox ("Unknown error occured in sql query subprocedure")
GoTo ending
End Sub
Remember to activate "Microsoft ActiveX data object 2.8 library" or higher in VBA editor (tools -> references...).
Keep in mind, that maximum size for data in each sheet is 256 columns and 65535 rows.
Works with Excel 2007.
Hope, this will help.
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