当使用vb6未安装office时,迭代excel工作表名称

时间:2013-02-20 15:01:52

标签: excel vb6 worksheet

由于ACE.OLEDB提供商,我可以阅读没有安装excel的excel表。 我也可以使用以下内容迭代工作表,但是如果我没有弄错的话,它需要安装办公室:

 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构建了一个动态导入器,通常我们可以通过他们的服务器更轻松地访问公司,与客户端PC相比,它可以减少安装办公室的可能性。

所以我想在导入excel文件时不要完全依赖办公室。 当然这不是一个主要功能,我可以将工作表名称存储为文本字段,但如果可以选择相关的工作表名称,那就更好了。

可以这样做,在vb6中吗? 感谢

2 个答案:

答案 0 :(得分:1)

喜欢这个吗?

'~~> 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

<强>截图

我添加了List1Command1以显示代码的工作原理

enter image description here

答案 1 :(得分:1)

你可以使用普通的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