combining multiple workbooks into one worksheet - excel

I am currently trying to get data recorded into excel workbooks to be automatically copied over onto one "mass data" sheet. The files are named by date ex. "5-28-17". There is one for each day of the month. I'd like to collect all data into one sheet, as previously stated, in order by date descending.
I am currently using this code which should place all of the different workbooks onto their own worksheet, but I am having issues with that as well.
Option Explicit
Const path As String = "C:\Users\dt\Desktop\dt kte\"
Sub GetSheets()
Dim FileName As String
Dim wb As Workbook
Dim sheet As Worksheet
FileName = Dir(path & "*.xls*")
Do While FileName <> ""
Set wb = Workbooks.Open(FileName:=path & FileName, ReadOnly:=True)
For Each sheet In wb.Sheets
sheet.Copy After:=ThisWorkbook.Sheets(1)
Next sheet
wb.Close
FileName = Dir()
Loop
End Sub
I am trying to do this with VBA. There are 15 columns in the sheets I'm pulling from and the sheet I want to copy to. All line up perfectly. Is there a way to move the sheets from the WB I'm currently working on which should contain a worksheet for each WB onto one mass worksheet? Or can I pull all data directly from the folder with all of the workbooks saved by date to one worksheet?

I would use this AddIn.
https://www.rondebruin.nl/win/addins/rdbmerge.htm
It will do what you want, and a whole lot more as well.

Consider using an MS Access database. Not to worry if you do not have the Office GUI .exe app installed. Because you use a Windows machine, you do have its Jet/ACE SQL Engine (.dll files).
CREATE DATABASE
Sub CreateDatabase()
On Error GoTo ErrHandle
Dim fso As Object, olDb As Object, db As Object
Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0"
Const strpath As String = "C:\Path\To\ExcelDatabase.accdb"
' CREATE DATABASE
Set fso = CreateObject("Scripting.FileSystemObject")
Set olDb = CreateObject("DAO.DBEngine.120")
If Not fso.FileExists(strpath) Then
Set db = olDb.CreateDatabase(strpath, dbLangGeneral)
End If
MsgBox "Successfully created database!", vbInformation
ExitSub:
Set db = Nothing: Set olDb = Nothing: Set fso = Nothing
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Resume ExitSub
End Sub
CREATE, POPULATE, EXPORT EXCEL TABLE (Excel files never opened)
Sub CreateTable()
On Error GoTo ErrHandle
Dim conn As Object, rst As Object
Dim constr As String, FileName As String, i As Integer
Const xlpath As String = "C:\Users\dt\Desktop\dt kte\"
Const accpath As String = "C:\Path\To\ExcelDatabase.accdb"
' CONNECT TO DATABASE
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & accpath & ";"
Set conn = CreateObject("ADODB.Connection")
conn.Open constr
i = 1
FileName = Dir(xlpath & "*.xls*")
Do While FileName <> ""
If i = 1 Then
' CREATE TABLE VIA MAKE TABLE QUERY
conn.Execute "SELECT * INTO MyExcelTable" _
& " FROM [Excel 12.0 Xml;HDR=Yes;" _
& " Database=" & xlpath & FileName & "].[Sheet1$]"
Else
' POPULATE VIA APPEND QUERY
conn.Execute "INSERT INTO MyExcelTable" _
& " SELECT * FROM [Excel 12.0 Xml;HDR=Yes;" _
& " Database=" & xlpath & FileName & "].[Sheet1$]"
End If
i = i + 1
FileName = Dir()
Loop
' EXPORT TO EXCEL
Set rst = CreateObject("ADODB.Recordset")
rst.Open "SELECT * FROM MyExcelTable", conn
ThisWorkbook.Worksheets("MASS_DATA").Range("A1").CopyFromRecordset rst
' CLOSE CONNECTION
rst.Close: conn.Close
MsgBox "Successfully created and populated table!", vbInformation
ExitSub:
Set rst = Nothing: Set conn = Nothing
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Resume ExitSub
End Sub

Related

Excel to Word Macro resulting in Run-time error 462

I've written a VBA macro which resides in an Excel workbook. When run, it will open an existing Word document (which is stored in the same directory as the Excel workbook), copy some content from cells in the Excel workbook into the Word document, save the Word doc under a new name (in the same directory) and kill the original Word doc. This process works as expected on first run. But on a second run, I get a Run-time error 462. I'm sure it's due to my ignorance around creating and using application instances within VBA code (I've just begun learning). I'm using Microsoft 365 Apps for Enterprise.
Sub ExcelToWord()
Dim wordApp As Word.Application
Dim wDoc As Word.Document
Dim strFile As String
'Open Word file
strFile = ("G:\HOME\Word File.docx")
Set wordApp = CreateObject("word.Application")
Set wDoc = wordApp.Documents.Open("G:\HOME\Word File.docx")
wordApp.Visible = True
'Copy data from Excel to Word
wDoc.ContentControls(1).Range.Text = Sheets("Model").Cells(4, 2)
wDoc.ContentControls(2).Range.Text = Format(Date, "mm/dd/yyyy")
wDoc.ContentControls(3).Range.Text = Sheets("Model").Range("X4")
Word.Application.Activate
'Save Word Document with new name
ActiveDocument.SaveAs Filename:=ActiveDocument.Path & "\" & Format(Sheets("Model").Range("B14"), "YYYY") & " " & ThisWorkbook.Sheets("Model").Range("B4") & " " & Format(Date, "YYYY-mm-dd") & ".docx"
'Delete original Word document
Kill strFile
End Sub
I've researched this for hours and tried multiple solutions, including commenting out all of the Copy Data block to try and zero in on the error. But no luck. I hope I've posted this request properly. Thank you in advance for any help.
Is this what you are trying? I have commented the code but if you face any issues, simply ask. What you have is Early Binding. I have used Late Binding so that you do not need to add any references to the MS Word application.
Option Explicit
Private Const wdFormatXMLDocument As Integer = 12
Sub ExcelToWord()
Dim oWordApp As Object, oWordDoc As Object
Dim FlName As String
Dim FilePath As String
Dim NewFileName As String
'~~> This is the original word file. Change as applicable
FlName = "G:\HOME\Word File.docx"
'~~> Check if word file exists
If Dir(FlName) = "" Then
MsgBox "Word File Not Found"
Exit Sub
End If
'~~> Establish an Word application object if open
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")
'~~> If not open then create a new word application instance
If Err.Number <> 0 Then
Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
oWordApp.Visible = True
Set oWordDoc = oWordApp.Documents.Open(FlName)
With oWordDoc
'~~> File path
FilePath = .Path & "\"
'~~> New File name
NewFileName = FilePath & _
Format(ThisWorkbook.Sheets("Model").Range("B14").Value, "YYYY") & _
" " & _
ThisWorkbook.Sheets("Model").Range("B4").Value & _
" " & _
Format(Date, "YYYY-mm-dd") & ".docx"
'~~> Copy data from Excel to Word
.ContentControls(1).Range.Text = Sheets("Model").Cells(4, 2).Value2
.ContentControls(2).Range.Text = Format(Date, "mm/dd/yyyy")
.ContentControls(3).Range.Text = Sheets("Model").Range("X4").Value2
'~~> Save the word document
.SaveAs Filename:=NewFileName, FileFormat:=wdFormatXMLDocument
DoEvents
End With
'~~> Delete original Word document
Kill FlName
End Sub

Excel run macro in another workbook, reference data on the first then close them both. Only one will close

I have a templated Excel file that will be is used to save the cell values to SQL. There will be about a thousand of these all with different names that perform the same function. For this reason I wanted to remove my code from the template into another file allowing for global changes if needed.
The User works from File A and hits the save button executing the following code to run the Macro contained in File B.
Sub Save_Inspection()
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks("SaveInspectionData.xlsm")
On Error GoTo 0
If wb Is Nothing Then Set wb = Workbooks.Open("\\SERVER\FOLDER\Files\XDomainDocs\SaveInspectionData.xlsm")
Dim FileName As String
FileName = ThisWorkbook.Name
Run "SaveInspectionData.xlsm!sheet1.Save_Inspection", FileName
wb.Close False
Set wb = Nothing
End Sub
Below is the code used to save the data residing on File B. Note - it is undermentioned at this time how many rows or columns there will, so I am looping through to create the SQL query and qty of rows, columns etc. This all works fine.
My problem is when I try to close the workbooks. I want them both to close and regardless or what I try only one of the two will close. The code below reflects the simplest close method, but I have tried several other techniques.
After some searching it may be something to do with my use of "With" statements to reference File A, but I am not sure.
Thanks in advance!
Sub Save_Inspection(FileName As String)
On Error GoTo errH
Dim strUserDomain As String
Dim cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim InspectionId As Integer 'Will use this Id to associate all results to this Inspection Instance
Dim Query As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
'Find proper connection string
strUserDomain = Environ$("UserDomain")
`If strUserDomain = "A" Then
Server_Name = "ServerA"
Database_Name = "Inspection"
User_ID = "xxx"
Password = "xxx"
ElseIf strUserDomain = "B" Then
Server_Name = "ServerB"
Database_Name = "Inspection"
User_ID = "xxx"
Password = "xxx"
ElseIf strUserDomain = "C" Then
Server_Name = "ServerC"
Database_Name = "Inspection"
User_ID = "xxx"
Password = "xxx"
Else
'Something must be wrong
Exit Sub
End If
Workbooks(FileName).Activate
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks(FileName)
Set ws = wb.Sheets(1)
'Let's Save this stuff!
Dim DateInspected, PartNumber, LotNumber, Revision As String
'Set values
With ws
'DateInspected = .Range("Q5").Value
PartNumber = .Range("K4").Value
LotNumber = .Range("G3").Value
Revision = .Range("Q4").Value
End With
Query = "INSERT INTO InspectionCatalog (DateInspected, PartNumber, LotNumber, Revision) VALUES (GETDATE(), '" & PartNumber & "', '" & LotNumber & "', '" & Revision & "')"
Set cn = New ADODB.Connection
cn.Open "Provider=SQLOLEDB;Server=" & Server_Name & ";Initial Catalog=" & Database_Name & ";Uid=" & User_ID & ";Pwd=" & Password & ";"
cn.Execute (Query)
rs.Open "SELECT ##identity AS InspectionId", cn
InspectionId = rs.Fields("InspectionId")
'MsgBox (InspectionId)'For testing
'Loop through all cells on sheet and save results
Call LoopThroughResults(InspectionId, FileName, strUserDomain)
Exit Sub
errH:
MsgBox Err.Description
End Sub
Sub LoopThroughResults(InspectionId As Integer, FileName As String, strUserDomain As String)
On Error GoTo errH
'Declare Variables
Dim RowCount As Integer
Dim CollCount As Integer
Dim Coll_Count As Integer
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks(FileName)
Set ws = wb.Sheets(1)
'Find the number of rows in the sheet based on a value in Col U
With ws
RowCount = .Cells(.Rows.Count, "G").End(xlUp).Row
'MsgBox RowCount
End With
'Go through each row and find the number of columns that are filled
'Set CollCount to the longest row - ignoring 1-9 these are header fields
For i = 10 To RowCount
With ws
Coll_Count = .Cells(i, .Columns.Count).End(xlToLeft).Column
If Coll_Count > CollCount Then
'Find the length of the longest row
CollCount = Coll_Count
End If
'MsgBox "Row " & i & " Has " & Coll_Count & " Columns!"
End With
Next i
'MsgBox "The Row with the Most data has " & CollCount & " Columns!"
'Save Col Count to be used for retrieving the data later
Dim Query As String
Query = "UPDATE InspectionCatalog SET CollCount='" & CollCount & "', [RowCount]='" & RowCount & "' WHERE InspectionId='" & InspectionId & "' "
Call SaveResults(Query, strUserDomain)
Dim QueryStart As String
Dim QueryEnd As String
'Loop through each row starting at 2 (Not 10, this time we want to capture all data
For i = 2 To RowCount
'Reset Query String befor hitting next row
QueryStart = "INSERT INTO InspectionResults ("
QueryEnd = " VALUES ("
'Loop through each column to create insert query
For n = 1 To CollCount
QueryStart = QueryStart & "Col" & n & ","
QueryEnd = QueryEnd & "N'" & Workbooks(FileName).Worksheets("Inspection Report").Cells(i, n).Value & "',"
Next n
QueryStart = QueryStart & "InspectionId)"
QueryEnd = QueryEnd & "'" & InspectionId & "');"
'MsgBox QueryStart & QueryEnd
Call SaveResults(QueryStart & QueryEnd, strUserDomain)
Next i
MsgBox "Inspection Data Has Been Saved"
Call CloseWorkBooks(FileName)
Exit Sub
errH:
MsgBox Err.Description
End Sub
Sub SaveResults(Query As String, strUserDomain As String)
On Error GoTo errH
Dim cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
'Find proper connection string
strUserDomain = Environ$("UserDomain")
If strUserDomain = "A" Then
Server_Name = "ServerA"
Database_Name = "Inspection"
User_ID = "xxx"
Password = "xxx"
ElseIf strUserDomain = "B" Then
Server_Name = "ServerB"
Database_Name = "Inspection"
User_ID = "xxx"
Password = "xxx"
ElseIf strUserDomain = "C" Then
Server_Name = "ServerC"
Database_Name = "Inspection"
User_ID = "xxx"
Password = "xxx"
Else
'Something must be wrong
Exit Sub
End If
Set cn = New ADODB.Connection
cn.Open "Provider=SQLOLEDB;Server=" & Server_Name & ";Initial Catalog=" & Database_Name & ";Uid=" & User_ID & ";Pwd=" & Password & ";"
cn.Execute (Query)
Exit Sub
errH:
MsgBox Err.Description
End Sub
Sub CloseWorkBooks(FileName As String)
Workbooks(FileName).Close SaveChanges:=False
Workbooks("SaveInspectionData.xlsm").Close SaveChanges:=False
Exit Sub
End Sub
Note that Application.Run executes the code in the same 'environment' as the current workbook. Basically the workbook executing Application.Run is the one running the code, and the new workbook will be linked to the same session.
This will result in the peculiar situation that you are observing.
Closing the workbook executed by 'Run' will make any macro (sub, function, object, sheet) in this workbook go out of scope, and any code run will stop running in this workbook. In addition as the notebook was closed, the code will not 'finish' in the executed workbook and thus we will not return to the original workbook, effectively halting any execution in the original notebook.
Additionaly as the code will try to return to the original workbook, to finish the original running sub (here Save_Inspection() in the original workbook), the two workbooks are linked to the same session (or environment), and thus closing this workbook first will Halt the original code running (going to the next line in Save_Inspection becomes effectively impossible as the workbook is now closed), and this will end the session as well.
Thus closing all workbooks in a workbook opened and executed by Application.Run is not possible directly. Workarounds can be done. The simplest is closing all workbooks in the original workbook (placing wb.close false: Thisworkbook.close false after application.run). Alternatively making a sub in the second workbook that runs 'Application.Ontime' and saves the filename to a cell for use in the function run by 'ontime' should make certain that the two sessions wont be linked while running code in the second notebook. But this i am less certain is actually the case.
Below is the code in the original notebook. If the original workbook finishes this should close the workbooks in the end.
Sub Save_Inspection()
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks("SaveInspectionData.xlsm")
On Error GoTo 0
If wb Is Nothing Then
Set wb = Workbooks.Open(ThisWorkbook.Path & "SaveInspectionData.xlsm")
End If
Dim FileName As String
FileName = ThisWorkbook.Name
Run "SaveInspectionData.xlsm!sheet1.CloseBooks", FileName
wb.Close False
ThisWorkbook.Close False
Set wb = Nothing
End Sub
Above Oliver does a great job explaining why my procedures where not working properly. In order to fix this I removed the call's to close the workbooks, the code in workbook A handles that on it's own. I did make some small changes to the above code to handle closing Excel or the workbook based on the qty of instances open.
Sub Save_Inspection()
Dim wb As Workbook
Dim wb2 As Workbook
On Error Resume Next
Set wb = Workbooks("SaveInspectionData.xlsm")
On Error GoTo 0
If wb Is Nothing Then Set wb = Workbooks.Open("\\Server\Cloud9\Files\XDomainDocs\SaveInspectionData.xlsm")
Dim FileName As String
FileName = ThisWorkbook.Name
Run "SaveInspectionData.xlsm!sheet1.Save_Inspection", FileName
If Application.Workbooks.Count > 2 Then
wb.Close False
ThisWorkbook.Close False
Set wb = Nothing
Else
Application.Quit
End If
End Sub

How to save .xlsx to .csv or .txt from Access VBA?

I've successfully used Access VBA to export a query to .xlsx, and I have used VBA to open the .xlsx file, but now I need to do "save as" to convert the file to a .csv or, if possible, .txt. This is part of a large automated process with thousands of files, so I really can't have any manual steps. I need the process from query to .txt to be totally automated within Access VBA. Here is my current code, which successfully opens the file I've created:
Sub Export_Reduced_Inforce()
Dim Dest_Path, Dest_File As String
Dim xlApp As Object
Dest_Path = "C:\Inforce_Reduction\Result Files\"
Dest_File = "Test1"
DoCmd.TransferSpreadsheet acExport, 10, _
"0801_Reduce Inforce", Dest_Path & Dest_File, True
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.Workbooks.Open Dest_Path & Dest_File & ".XLSX", True, False
End Sub
you can adapt this line of code to your needs:
xl2.ActiveWorkbook.SaveAs ThisWorkbook.Path & "/" & "name your file" & ".csv"
xl2= it's the excel file you wana save it so change that with xlApp or what you have declare your excel file
Just in case you want to expand you idea and export ALL objects in your DB to Text files, run the script below.
Private Sub Command4_Click()
On Error GoTo Err_ExportDatabaseObjects
Dim db As Database
'Dim db As DAO.Database
Dim td As TableDef
Dim d As Document
Dim c As Container
Dim i As Integer
Dim sExportLocation As String
Set db = CurrentDb()
sExportLocation = "C:\Users\rs17746\Desktop\Text_Files\" 'Do not forget the closing back slash! ie: C:\Temp\
For Each td In db.TableDefs 'Tables
If Left(td.Name, 4) <> "MSys" Then
DoCmd.TransferText acExportDelim, , td.Name, sExportLocation & "Table_" & td.Name & ".txt", True
End If
Next td
Set c = db.Containers("Forms")
For Each d In c.Documents
Application.SaveAsText acForm, d.Name, sExportLocation & "Form_" & d.Name & ".txt"
Next d
Set c = db.Containers("Reports")
For Each d In c.Documents
Application.SaveAsText acReport, d.Name, sExportLocation & "Report_" & d.Name & ".txt"
Next d
Set c = db.Containers("Scripts")
For Each d In c.Documents
Application.SaveAsText acMacro, d.Name, sExportLocation & "Macro_" & d.Name & ".txt"
Next d
Set c = db.Containers("Modules")
For Each d In c.Documents
Application.SaveAsText acModule, d.Name, sExportLocation & "Module_" & d.Name & ".txt"
Next d
For i = 0 To db.QueryDefs.Count - 1
Application.SaveAsText acQuery, db.QueryDefs(i).Name, sExportLocation & "Query_" & db.QueryDefs(i).Name & ".txt"
Next i
Set db = Nothing
Set c = Nothing
MsgBox "All database objects have been exported as a text file to " & sExportLocation, vbInformation
Exit_ExportDatabaseObjects:
Exit Sub
Err_ExportDatabaseObjects:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ExportDatabaseObjects
End Sub
Here is one more version for you. This will export the results of each query, each to a separate text file.
Private Sub Command0_Click()
Dim qdf As QueryDef
Dim strFileName As String
For Each qdf In CurrentDb.QueryDefs
If Left(qdf.Name, 1) <> "~" Then
'you need to figure out TransferText command. Maybe
'you won't be lazy and expect people to read it to
'you and tutor you on how it works.
strFileName = qdf.Name
'Docmd.TransferText ....
DoCmd.TransferText transferType:=acExportDelim, TableName:=strFileName, FileName:="C:\test\" & strFileName & ".txt", hasfieldnames:=True
End If
Next qdf
MsgBox "Done"
End Sub
Ok, well, you can use this, to print the actual SQL.
Private Sub Command2_Click()
Dim db As Database
Dim qr As QueryDef
Set db = CurrentDb
For Each qr In db.QueryDefs
TextOut (qr.Name)
TextOut (qr.SQL)
TextOut (String(100, "-"))
Next
End Sub
Public Sub TextOut(OutputString As String)
Dim fh As Long
fh = FreeFile
Open "C:\Users\rs17746\Desktop\Text_Files\sample.txt" For Append As fh
Print #fh, OutputString
Close fh
End Sub

Linking Excel Tables in Access Gives Read-Only Error

I have a couple of Excel 2010 files that are mapped and linked to an Access 2010 database. I need to add another file so that three are mapped instead of two. I linked the excel file from the Import and Link tab under External Database. That seems to be okay. But when I run the code that re-maps the excel file, it gives me a runtime error 3027: Database or Object is read only. None of the files or database are read-only.
This is the code to re-map the files from a new location (ex. from the X-drive to the mail W-drive), which would also add the new excel file. Should something be added here to let me add new files?
Private Sub cmdAcceptPath_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strPath As String
Dim strFileName As String
Dim strSourceDB As String
Dim strTableName As String
Dim sList As String
Dim gMsgBoxTitle As String
On Error GoTo Error_Handler:
DoCmd.SetWarnings False
strSourceDB = Me.tExcelPath.Value
Set db = CurrentDb
strSQL = "update tblBackendFiles set setting=" & setData(strSourceDB) & " where code='SourceExcel'"
DoCmd.RunSQL strSQL
'-- Verify linked tables by refreshing
strSQL = "select setting, ExcelPath, ExcelRange from tblBackendFiles where code='SourceExcelWB'"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
'Open remapprogress
DoCmd.OpenForm "frmReMapProgress"
sList = ""
rs.MoveFirst
While Not rs.EOF
strTableName = rs!Setting
sList = sList & vbNewLine & "Deleting Table: " & strTableName
Forms!frmReMapProgress.tbProgress = sList
If TableExists(strTableName) Then
DoCmd.DeleteObject acTable, strTableName
End If
rs.MoveNext
Wend
sList = ""
'-- Relink inventory database
rs.MoveFirst
While Not rs.EOF
sList = sList & vbNewLine & "Linking Table: " & strTableName
Forms!frmReMapProgress.tbProgress = sList
Forms!frmReMapProgress.Refresh
strTableName = rs!Setting
strPath = strSourceDB & "\" & rs!ExcelPath
Debug.Print strPath
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, strTableName, strPath, True, rs!ExcelRange
rs.MoveNext
Wend
rs.Close
MsgBox "Re-Mapping Excel Links is Complete!"
GoTo exit_sub:
'If error occurs
Error_Handler:
MsgBox Err.number & ": " & Err.Description, vbInformation + vbOKOnly, gMsgBoxTitle
exit_sub:
Set db = Nothing
Set rs = Nothing
DoCmd.SetWarnings True
DoCmd.Close acForm, "frmReMapProgress"
DoCmd.Close acForm, "frmReMapExcel"
End Sub
You don't need to delete and recreate the link to the Excel file. Just close the linked table (if open) and replace the Excel file with the new copy.
When you open the linked table, it will read from the new file.

Reading Data using OLEDB from opened Excel File

I have an excel file(Lets' say File X) with 2 sheets. In first sheet I display charts. Second I have data for the chart. In order to get data from chart, I need to process that data as we do in SQL like Group by, order by. Is there any way I can use oledb to read data from second sheet using VBA code in same excel file(file X)?
Thanks!!
Here's an example of using SQL to join data from two ranges: it will work fine if the file is open (as long as it has been saved, because you need a file path).
Sub SqlJoin()
Dim oConn As New ADODB.Connection
Dim oRS As New ADODB.Recordset
Dim sPath
Dim sSQL As String
sSQL = "select a.blah from <t1> a, <t2> b where a.blah = b.blah"
sSQL = Replace(sSQL, "<t1>", Rangename(Sheet1.Range("A1:A5")))
sSQL = Replace(sSQL, "<t2>", Rangename(Sheet1.Range("C1:C3")))
If ActiveWorkbook.Path <> "" Then
sPath = ActiveWorkbook.FullName
Else
MsgBox "Workbook being queried must be saved first..."
Exit Sub
End If
oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & sPath & "';" & _
"Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"
oRS.Open sSQL, oConn
If Not oRS.EOF Then
Sheet1.Range("E1").CopyFromRecordset oRS
Else
MsgBox "No records found"
End If
oRS.Close
oConn.Close
End Sub
Function Rangename(r As Range) As String
Rangename = "[" & r.Parent.Name & "$" & _
r.Address(False, False) & "]"
End Function

Resources