使用ADODB从关闭文件中按Tab键顺序返回工作表名称

Question

我能够连接和查询特定工作表。某些文件可能会有第一个工作表名称不同或更改，有时可能会有多个文件名称。

我尝试了几个不同的函数来返回完整列表。但是，没有人按照它们在Excel中显示的顺序给我提供工作表选项卡名称。

最简单的方法是这样的。

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 

我想我可以通过datecreated或datemodified来确定，但所有4的日期都是一样的。

> 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 

因此，它给了我工作表选项卡名称列表的字母排序。

但是在工作表的顺序是：

>[Sheet1][Avion][Sheet2][Meow] 

我无法找到任何属性来告诉我订单。

Answer 1

摘自：https://www.mrexcel.com/forum/excel-questions/406243-get-sheet-number-using-adox.html

Sub GetSheetNames() 
    '###Requires a reference to Microsoft DAO x.x Object Library 

    Dim FName As String, i As Long, WB As DAO.Database 

    FName = ThisWorkbook.Path & "\ADOXSource.xlsx" 


    Set WB = OpenDatabase(FName, False, True, "Excel 8.0;") 

    With WB.tabledefs 
     For i = 1 To .Count 
      Debug.Print i, .Item(i - 1).Name '<< TableDefs Is zero based 
     Next i 
    End With 

    WB.Close 

End Sub 

Answer 2

这是我建的一天用DAO，但我还是想弄清楚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 

然后运行我有一堆代码打开对话框，然后确定格式和字符串：

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 

然后我有：

'Get Spreadsheets 
Dim FileSpreadsheets() As String  
FileSpreadsheets = GetSheets(FileToOpen, FileExt) 

然后，你可以做任何你需要做的，但作为一个例子来获得一个MsgBox：

mymsg = "Count: " & UBound(FileSpreadsheets) & vbNewLine & vbNewLine & _ 
"Sheets:" & vbNewLine & vbNewLine 

For Each Sheet In FileSpreadsheets 
    mymsg = mymsg + Sheet & vbNewLine 
Next Sheet 

MsgBox mymsg