迭代通过Excel工作表名称，当办公室没有安装使用vb6
由于ACE.OLEDB提供程序，我可以读取没有安装Excel的Excel表格。 我也可以使用下面的代码遍历工作表，但是如果我没有弄错的话，它需要安装office：
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 我希望能够查询Excel表格来填充一个下拉列表，但即使办公室没有安装，我可以这样做吗？ 为了解释我们目前的情况，我已经为我们的crm构build了一个dynamic导入器，通常我们通过他们的服务器更容易访问公司，与客户端pc相比，办公室安装的可能性更小。
所以我想在导入一个excel文件的时候不要完全依靠office。 当然，这不是一个主要的function，我可以将工作表名称存储为文本字段，但如果可以select相关的工作表名称，则会更好。
可以这样做，并在VB6？ 谢谢
你可以使用普通的ADO（不是ADOX）来做这样的枚举
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
喜欢这个？
'~~> 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
截图
我添加了一个List1和一个Command1来显示代码如何工作
