I need help getting spreadsheet names from closed file using ADODBwith tab order
I am able to successfully connect and query specific sheets. Some files I am dealing with may have the first spreadsheet name different or changing and sometimes there may be more than one.
i tried to write a few different functions to return a full list. However none give me the spreadsheet tab names in the order they appear in excel...
The easiest method is this
Set cat = CreateObject("ADOX.Catalog")
Set cat.ActiveConnection = objConnection
Debug.Print cat.Tables.Count
For Each tbl In cat.Tables
Debug.Print tbl.Name
Debug.Print tbl.datecreated
Debug.Print tbl.datemodified
Next tbl
I thought maybe i could determine by datecreated or datemodified, but the dates on all 4 are the same
This prints for me:
Avion$
3/17/2017 12:43:19 PM
3/17/2017 12:43:19 PM
Meow$
3/17/2017 12:43:19 PM
3/17/2017 12:43:19 PM
Sheet1$
3/17/2017 12:43:19 PM
3/17/2017 12:43:19 PM
Sheet2$
3/17/2017 12:43:19 PM
3/17/2017 12:43:19 PM
However the actual spreadsheet order is:
[Sheet1][Avion][Sheet2][Meow]
So it gives me alphabetic sorting of the spreadsheet tab name list...
I can't seem to find any property to tell me the order...
Help?
This is what I built the other day with DAO but I still want to figure out ADO...
Public Function GetSheets(ByVal FileToOpen As String, ByVal FileExt As String)
Dim Shts() As String, ShtCnt As Integer: ShtCnt = 0
ReDim Shts(0 To ShtCnt)
Dim dbE As Object, db As Object, tbl As Object
On Error Resume Next
Set dbE = CreateObject("DAO.DBEngine")
Set dbE = CreateObject("DAO.DBEngine.35")
Set dbE = CreateObject("DAO.DBEngine.36")
On Error GoTo 0
Set db = dbE.OpenDatabase(FileToOpen, False, False, FileExt & ";HDR=Yes;")
For Each tbl In db.TableDefs
Shts(ShtCnt) = Mid(tbl.Name, 1, Len(tbl.Name) - 1)
ShtCnt = ShtCnt + 1
ReDim Preserve Shts(0 To ShtCnt)
Next
Set dbE = Nothing
Set db = Nothing
Set tbl = Nothing
GetSheets = Shts
End Function
Then to run I have a bunch of code for an open dialog, then it determines the format and the strings:
Select Case Right(FileToOpen, Len(FileToOpen) - InStrRev(FileToOpen, "."))
Case "xls", "XLS"
Provider = "Microsoft.Jet.OLEDB.4.0;"
FileExt = "Excel 8.0"
Case "xlsx", "XLSX"
Provider = "Microsoft.ACE.OLEDB.12.0;"
FileExt = "Excel 12.0"
Case "csv", "CSV"
Provider = "Microsoft.Jet.OLEDB.4.0;"
FileExt = "Excel 8.0"
Case Else
GoTo Err:
End Select
Then I have:
'Get Spreadsheets
Dim FileSpreadsheets() As String
FileSpreadsheets = GetSheets(FileToOpen, FileExt)
Then you can do whatever you need to do but as an example to get a msgbox:
mymsg = "Count: " & UBound(FileSpreadsheets) & vbNewLine & vbNewLine & _
"Sheets:" & vbNewLine & vbNewLine
For Each Sheet In FileSpreadsheets
mymsg = mymsg + Sheet & vbNewLine
Next Sheet
MsgBox mymsg
|