We are frequently using some Excel files as a datasource for massive imports in our database. At the code level, we always refer to the corresponding data source as:
set rs = New ADODB.recordset
rs.open "SELECT * FROM [sheet1$]", myConnectionString, etc
Of course, this procedure only works when there's a sheet in the Excel file which is named [sheet1]. I'd like to add some sheet management code here, but without having to create an instance of the original Excel file, opening it, and so on (my users might get a file with a different sheet name, and might not have Excel installed).
Any idea?
You can open a recordset with the ADO OpenSchema method and then list the table (sheet) names in your workbook.
Public Sub SheetsInWorkbook()
Dim strConnect As String
Dim cn As Object
Dim rs As Object
Dim strPath As String
strPath = CurrentProject.Path & Chr(92) & "temp.xls"
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source='" & strPath & "';" _
& "Extended Properties='Excel 8.0';"
Set cn = CreateObject("ADODB.Connection")
cn.ConnectionString = strConnect
cn.Open
Set rs = cn.OpenSchema(20) '20 = adSchemaTables '
Debug.Print "TABLE_NAME"
Do While Not rs.EOF
Debug.Print rs!TABLE_NAME
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Related
I saw that this error isn't new, but I can't find the solution.
I have one xls file that use one sheet like as db and with ADODB i get the recordsets that I need.
The code is Very simple and work right for each pc(5) that I tested, with WIN7, WIN10, 32 or 64 bit.
But I've on PC, it's customer Pc, that get me this error: Run time error '3706': Provider cannot be found,
I has checked the WIN version, the office version, they are the same like other PC, WIN10 64 Bit, MS Office 32Bit
There are more control that I've to do to resolve this problem?!?!
thanks for any suggestions
fabrizio
My xls file have 2 sheet, 1th named "dati" with two columns (Anno, Pezzi), 2th named "test" empty, this is the code:
Sub testConn()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strsql As String
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set rs = New ADODB.Recordset
#If Win64 Then
cn.Open "Provider=Microsoft.Jet.OLEDB.12.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 8.0;HDR=Yes;"";"
#Else
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 8.0;HDR=Yes;"";"
#End If
strsql = "SELECT anno, Sum(Pezzi)as Tpz from [dati$] group by anno"
rs.Open strsql, cn, adOpenStatic, adLockReadOnly, adCmdUnspecified
rs.MoveFirst
With Worksheets("test")
.Cells.ClearContents
.Range("A1") = "Anno"
.Range("B1") = "T.Pz"
.Range("A2").CopyFromRecordset rs
.Activate
.Select
End With
End Sub
these references was added into file:
Microsoft ActiveX Data Objects 6.1 Library
Microsoft ActiveX Data Recordset 2.8 Library
This works, there are some small details you use not suitable. Version 12, driver is ace not jet,and Extended Properties also is Excel 12.0
And no need to add library.
Sub testConn()
Dim cn As Object
Dim rs As Object
Dim strsql As String
Dim connString
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
If Application.Version < 12 Then
connString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 8.0;HDR=Yes;"";"
Else
connString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 12.0;HDR=Yes;"";"
End If
cn.Open connString
strsql = "SELECT anno, Sum(Pezzi) as Tpz from [dati$] group by anno"
Set rs = cn.Execute(strsql)
With Worksheets("test")
.Cells.ClearContents
.Range("A1") = "Anno"
.Range("B1") = "T.Pz"
.Range("A2").CopyFromRecordset rs
.Activate
.Select
End With
End Sub
I am trying to insert some values on the last row of the recordset which in this case is an Excel file that serves as my database. I have the code below that works in inserting the value of the textbox to the last row of the excel recordset. However, it did not create a new table row where the value was inserted.
Sub CreaterRow()
Dim strFile As String
Dim strConnect As String
Dim strSQL As String
Dim lngCount As Long
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
strFile = "C:\Excel\Test.xlsx"
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & _
";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
cnn.Open ConnectionString:=strConnect
strSQL = "SELECT [ID] FROM [Sheet1$]"
rst.Open Source:=strSQL, ActiveConnection:=cnn, CursorType:=adOpenForwardOnly, Options:=adCmdText
With rst
.AddNew
.Fields("ID").Value = tbx_ID.Value 'Inserting this in the recordset did not create a new row
.Update
End with
rst.Close
cnn.Close
End Sub
How can the table automatically create a new row that will include the value is inserted in the lastrow? Thank you.
This worked for me. You need to have the right cursor and lock type.
Sub CreaterRow()
Dim strFile As String
Dim strConnect As String
Dim strSQL As String
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
strFile = ThisWorkbook.Path & "\Data.xlsx"
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=""" & strFile & _
""";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
cnn.Open ConnectionString:=strConnect
strSQL = "SELECT [ID] FROM [Sheet1$]"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
With rst
.AddNew
.Fields("ID").Value = "ID00020"
.Update
End With
rst.Close
cnn.Close
End Sub
EDIT: if you're querying data from a Table/Listobject then appending records will not resize the list to include the added records. See: ADO: Excel: Is it possible to open recordset on table name?
EDIT2: If you use a named range instead of a ListObject, then you can query it by name (instead of using the sheet name) and the range will adjust when you insert new rows.
I'm using VBA in Windows 7 Excel 2016 to query an Excel table with SQL. The worksheet containing the data has over 200,000 rows.
I'm using the ActiveX Data Objects 6.1 library. Here's the code:
Private Sub TestADO()
Dim objConnection As ADODB.Connection
Dim objRecordset As ADODB.Recordset
Dim strCon As String
Dim strSQL As String
Dim strPath As String
Dim strSource As String
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")
Sheet2.UsedRange.Clear
strPath = ThisWorkbook.Path & "\"
strSource = ThisWorkbook.Name
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & strPath & strSource & "';" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"";"
strSQL = "Select * FROM [Sheet1$] " 'I've tried many queries, all have same problem
objConnection.Open strCon
objRecordset.Open strSQL, objConnection, adOpenStatic, adLockOptimistic, adCmdText
If Not objRecordset.EOF Then
Sheet2.Range("A1").CopyFromRecordset objRecordset
End If
End Sub
This works OK, except that any SQL query only searches in the first 36,201 rows of the data sheet. Is there a limit on the number of rows which can be searched, or on recordset contents, or am I doing something wrong?
I have a bit of code that loops through a bunch of files in a folder and loads the data into recordsets, storing the filenames and recordsets in a dictionary (as a key/value pair) for later use. The loop works fine for the first 64 files, but then it gives me an "Unspecified Error" dialog on the 65th try. The code breaks at the recordData.Open line (the loop calls the below function, so the For Each loop is not shown):
Public Function GetRecords(ByVal dataSrc as String) as ADODB.Recordset
Dim dir as String
Dim file as String
Dim recordData as ADODB.Recordset
Dim sql as String
Dim conn as String
dir = "C:\MyDirectory"
file = dataSrc & ".csv"
conn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & dir & ";" & _
"Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;"""
If DoesFileExist(dir & file) Then
sql = "select * from " & file & ";"
Set recordData = New ADODB.Recordset
recordData.CursorLocation = adUseClient
recordData.Open sql, conn, adOpenForwardOnly, adLockReadOnly, adCmdText
Else
Set recordData = Nothing
End If
Set GetRecords = recordData
recordData.Close
End Function
If I rename or delete the file it currently stops on, it errors out on the new 65th file, so I know the actual file itself is not to blame. Is there a limitation on the number of recordsets that I can open in one session, or am I opening them in an inefficient way?
Well, after tinkering with it, I discovered the problem lay in the connection. Instead of constructing the connection string as a string, I created a connection object and then closed it after opening the recordset. Must be some kind of limitation on the number of connections that can exist in a given session. Here is the revised function:
Public Function GetRecords(ByVal dataSrc as String) as ADODB.Recordset
Dim dir as String
Dim file as String
Dim recordData as ADODB.Recordset
Dim sql as String
Dim cn as ADODB.Connection
dir = "C:\MyDirectory"
file = dataSrc & ".csv"
If DoesFileExist(dir & file) Then
sql = "select * from " & file & ";"
Set recordData = New ADODB.Recordset
Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & dir & ";" & "Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;"""
.CursorLocation = adUseClient
.Open
End With
recordData.CursorLocation = adUseClient
recordData.Open sql, conn, adOpenForwardOnly, adLockReadOnly, adCmdText
cn.Close
Else
Set recordData = Nothing
End If
Set GetRecords = recordData
recordData.Close
End Function
I am working with the Microsoft OLE DB Provider for Jet to execute queries on spreadsheets in Excel using VBA. Is there a way to execute the following code on an unsaved workbook?
For example, ActiveWorkbook.FullName returns "Book1" if the workbook has never been saved. In that case the Data Source will assume the path is the active directory, and error out because the file was never saved.
Is there any way to use the Excel temporary file as the Data Source for Jet? I would like to test this but I don't even know how to return the Path and Name for the Excel temporary file.
Public Sub LocalJetQuery()
Dim objStartingRange As Range
Dim objConnection As New ADODB.Connection
Dim objRecordset As New ADODB.Recordset
Dim strDSN As String
Dim strSQL As String
Set objStartingRange = Application.Selection
If CLng(Application.Version) >= 12 Then
strDSN = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & objStartingRange.Worksheet.Parent.FullName & ";" _
& "Extended Properties=""Excel 12.0 Xml;HDR=No;IMEX=1"";"
Else
strDSN = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & objStartingRange.Worksheet.Parent.FullName & ";" _
& "Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
End If
strSQL = "SELECT * FROM [" & objStartingRange.Worksheet.Name & "$];"
objConnection.Open strDSN
objRecordset.Open strSQL, objConnection
Application.Workbooks.Add(xlWBATWorksheet).Sheets(1).Cells(1, 1).CopyFromRecordset objRecordset
End Sub
Thanks!
No. Just like David Fenton says in the comments.