Iterate through excel worksheet names, when office

问题:

I can read an excel sheet without excel being installed thanks to the ACE.OLEDB provider. I can also iterate through the worksheets using the following, but it requires that office is installed if I'm not mistaken:

 Set xlApp = CreateObject("Excel.Application")
    Set wb = xlApp.Workbooks.Open(txtExcelFile, ReadOnly:=True, editable:=False)
    If wb.Worksheets.Count = 0 Then
    MsgBox "Excel file contains no worksheets"
    GoTo SubEnd
    End If
    Dim i        As Integer

    For i = 1 To wb.Worksheets.Count
        cboWorksheet.AddItem (wb.Worksheets(i).Name)
    Next

I want to be able to query excel sheets to fill a drop down, but can i do that even if office is not installed? To explain our current situation, I've built a dynamic importer for our crm, and usually we have easier access to a company via their server which, compared to a client pc, will have a less probability of office being installed.

So I want to not rely on office completely while importing an excel file. Of course this is not a major feature, I can store the worksheet name as a text field, but it would be much nicer if one could pick the relevant worksheet name.

Can this be done, and in vb6? Thanks

回答1:

You can use plain ADO (not ADOX) to do the enumeration like this

Option Explicit

Private Sub Command1_Click()
    Dim vElem       As Variant

    For Each vElem In GetSheets("d:\temp\aaa.xlsx")
        Debug.Print vElem
    Next
End Sub

Private Function GetSheets(sFileName As String) As Collection
    Const adStateOpen As Long = 1
    Const adSchemaTables As Long = 20

    Set GetSheets = New Collection
    With CreateObject("ADODB.Connection")
        If LCase$(Right$(sFileName, 5)) = ".xlsx" Then
            .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sFileName & ";Extended Properties=Excel 12.0 Xml"
        Else
            .Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFileName & ";Extended Properties=Excel 8.0"
        End If
        If .State <> adStateOpen Then
            Exit Function
        End If
        With .OpenSchema(adSchemaTables)
            Do While Not .EOF
                If LCase$(!TABLE_NAME) <> "database" Then
                    GetSheets.Add !TABLE_NAME.Value
                End If
                .MoveNext
            Loop
        End With
    End With
End Function

回答2:

Like this?

'~~> Add Reference to MS ActiveX Data Objects xx.xx Library
Option Explicit

Private Sub Form_Load()
    Dim SheetName As String
    Dim RS As ADODB.Recordset
    Dim I As Long

    With CreateObject("ADOX.Catalog")
        .ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" _
                          & App.Path & "\sample.xls';" _
                          & "Extended Properties='Excel 5.0;HDR=No'"
        For I = 0 To .tables.Count - 1
            '~~> This will give you sheet names
            Debug.Print .tables(I).Name
        Next I
    End With
End Sub

Screenshot

I added a List1 and a Command1 to show how the code works