I am trying to use ADODB to automatically read information from specific cells on a closed workbook and put that information into a master sheet.
The closed workbooks all only have 1 sheet but they all have different names.
How do I make it so the macro automatically knows the name of the sheet?
I.E rs.Source = "SELECT * FROM [XXX$A1:A1] 'XXX being the name of the target sheet that the macro has found automatically
Sub ImportDataFromClosedSheet()
Dim cn As ADODB.Connection
Dim rs As ADODB.RecordsetSet
'This paragraph selects a target file
Dim file As FileDialog
Dim sItem As String
Dim GetFile As String
Set file = Application.FileDialog(msoFileDialogFilePicker)
With file
.Title = "Select a File"
.AllowMultiSelect = False
'.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFile = sItem
Set file = Nothing
cn = New ADODB.Connection
cn.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & GetFile & ";" & _
"Extended Properties='Excel 12.0 Xml;HDR=No';"
cn.Open
Set rs = New ADODB.Recordset
rs.ActiveConnection = cn
rs.Source = "SELECT * FROM [XXX$J14:J14]"
rs.Open
Sheet1.Range("A1").CopyFromRecordset rs
rs.Close
cn.Close
End Sub
I am trying to use ADODB to automatically read information from specific cells on a closed workbook and put that information into a master sheet.
The closed workbooks all only have 1 sheet but they all have different names.
How do I make it so the macro automatically knows the name of the sheet?
I.E rs.Source = "SELECT * FROM [XXX$A1:A1] 'XXX being the name of the target sheet that the macro has found automatically
Sub ImportDataFromClosedSheet()
Dim cn As ADODB.Connection
Dim rs As ADODB.RecordsetSet
'This paragraph selects a target file
Dim file As FileDialog
Dim sItem As String
Dim GetFile As String
Set file = Application.FileDialog(msoFileDialogFilePicker)
With file
.Title = "Select a File"
.AllowMultiSelect = False
'.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFile = sItem
Set file = Nothing
cn = New ADODB.Connection
cn.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & GetFile & ";" & _
"Extended Properties='Excel 12.0 Xml;HDR=No';"
cn.Open
Set rs = New ADODB.Recordset
rs.ActiveConnection = cn
rs.Source = "SELECT * FROM [XXX$J14:J14]"
rs.Open
Sheet1.Range("A1").CopyFromRecordset rs
rs.Close
cn.Close
End Sub
If you don't specify the sheetname in the SQL statement, The ADODB driver will use the first sheet. As you state that there is always only one sheet in the file, just use
rs.Source = "SELECT * FROM [J14:J14]"
However, if you really want to get the sheet names, use ADODB openShema
with the QueryType adSchemaTables
. The following function will return an array with all table names of an open connection - in case of Excel, "table" means sheets.
Function getTableNames(cn As ADODB.Connection)
Dim rs As ADODB.Recordset
Set rs = cn.OpenSchema(adSchemaTables)
Dim data
data = rs.GetRows
ReDim tableNames(LBound(data, 2) To UBound(data, 2))
Dim row As Long
For row = LBound(data, 2) To UBound(data, 2)
tableNames(row) = data(2, row)
Next
getTableNames = tableNames
End Function
Now, your code could look like this:
cn.Open
Dim sheetNames
sheetNames = getTableNames(cn)
Set rs = New ADODB.Recordset
rs.ActiveConnection = cn
rs.Source = "SELECT * FROM [" & sheetNames(0) & "J14:J14]"
rs.Open
Sheet1.Range("A1").CopyFromRecordset rs
rs.Close
cn.Close
A quick example using OpenSchema
:
Sub TestSchema()
Dim oConn As New ADODB.Connection
Dim oRS As New ADODB.Recordset, strPathtoTextFile, n
strPathtoTextFile = ThisWorkbook.Path & "\" & ThisWorkbook.Name
oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=""Excel 12.0;HDR=YES;MaxScanRows=1000;IMEX=1"";Data Source=" & strPathtoTextFile
Set oRS = oConn.OpenSchema(adSchemaTables)
ToSheet Sheet5.Range("A1"), oRS
End Sub
'write field names and data from `rs` to a worksheet starting at `rng`
Sub ToSheet(rng, rs)
Dim f, i
i = 0
rng.Resize(1000, 200).ClearContents '<<< adjust or comment out...
For Each f In rs.Fields
rng.Offset(0, i).Value = f.Name
i = i + 1
Next f
rng.Offset(1, 0).CopyFromRecordset rs
End Sub
Worksheet names (appended with $
) are in the field TABLE_NAME
If SQL is simply used for extracting static data without logical calculations or joining to other sheets, avoid the ADODB API use in Excel.
Instead, consider retrieving needed data using the Excel Object Model where you can simply call Workbooks.Open
and Worksheets.Range
, for straightforward implementation.
Dim wb As Workbook
' OPEN WORKBOOK
Set wb = Workbooks.Open(GetFile)
' RETRIEVE RANGE VALUE
With wb.Worksheets(1)
ThisWorkbook.Worksheets(1).Range("A1").Value = .Range("J14").Value
End With
' CLOSE WORKBOOK
wb.Close False
Set wb = Nothing
Above can be extended beyond one cell range of value(s).
set Rs=OpenSchema(adSchemaTables)
thensSheetName = Rs.Fields("table_name").Value
checkIf right(sSheetname,1)="$" then firstSheet=sSheetname End If
– ValNik Commented Jan 2 at 17:49