在VB中使用数据库打开EXcel文件,通过下面的代码获得它的工作表时,内容与实际工作表不一致?高手请进.

Question

Set RsTable = cnExcel.OpenSchema(adSchemaTables)
          Do Until RsTable.EOF
            Debug.Print "Table name: " & _
                RsTable!TABLE_NAME & vbCr & _
                "Table type: " & RsTable!TABLE_TYPE & vbCr
            RsTable.MoveNext
        Loop
        RsTable.Close
问题是:有的EXECL文件没有问题,有的EXECL文件会出现下面的情况:
Table name: 滨洲市$
Table type: TABLETable name: 滨洲市$_
Table type: TABLETable name: 荷泽市$
Table type: TABLETable name: 济南市$
Table type: TABLETable name: 聊城市$
Table type: TABLE
上面出现了两次滨洲市,事实上只有一个"滨洲市"工作表.
急用,谢谢

Answer 1

用Excel对象来做试试：Private Sub Command1_Click()
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open(App.Path & "\test.xls") '打开Excel文件
    Dim i As Integer
    For i = 1 To xlApp.Sheets.Count
        Debug.Print xlApp.Sheets(i).Name '打印工作表名
    Next
    xlApp.Quit
    Set xlApp = Nothing
End Sub

Answer 2

Private Sub Command1_Click()
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Workbooks.Open App.Path & "\test.xls" '打开Excel文件
    Dim i As Integer
    For i = 1 To xlApp.Sheets.Count
        Debug.Print xlApp.Sheets(i).Name '打印工作表名
    Next
    xlApp.Quit
    Set xlApp = Nothing
End Sub

Answer 3

Excel 作为数据库时就是这样。可以如下解决（利用一个 ComboBox 或 ListBox）：Private Declare Function SendMessagebyString Lib _
"user32" Alias "SendMessageA" (ByVal hWND As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As String) As LongPrivate Const LB_FINDSTRINGEXACT = &H1A2    '在 ListBox 中精确查找
Private Const CB_FINDSTRINGEXACT = &H158    '在 ComboBox 中精确查找Dim strTmp As String
Set RsTable = cnExcel.OpenSchema(adSchemaTables)
          Combo1.Clear
          Do Until RsTable.EOF
          strTmp = Left(RsTable!TABLE_NAME, InStr(RsTable!TABLE_NAME, "$") - 1)
          If SendMessagebyString(Combo1.hWnd, CB_FINDSTRINGEXACT, -1, strTmp) > 0 Then
            Combo1.AddItem strTmp   
            Debug.Print "Table name: " & _
                RsTable!TABLE_NAME & vbCr & _
                "Table type: " & RsTable!TABLE_TYPE & vbCr
          End If
          RsTable.MoveNext
        Loop
        RsTable.Close

Answer 4

更正：
If SendMessagebyString(Combo1.hWnd, CB_FINDSTRINGEXACT, -1, strTmp) >= 0 Then

Answer 5

'***********************************************************************/
'*    Function   Name:   ToExcel                                       */
'*    Input Arguments:                                                 */
'*    Out Arguments  :                                                 */
'*                   :                                                 */
'*    Description    :                                                 */
'*    Author         :              by yarno  QQ：84115357             */
'*    Date           :              2005-11-25                         */
'***********************************************************************/
Public Function ToExcel()On Error GoTo ErrorHandler        Dim exlapp As Excel.Application
Dim exlbook As Excel.Workbook
Set exlapp = CreateObject("Excel.Application")
Set exlbook = exlapp.Workbooks.Add
exlapp.Caption = "数据正在导出......"
exlapp.Visible = True
exlapp.DisplayAlerts = False

Dim exlsheet As Excel.Worksheet


Set exlsheet = exlbook.Worksheets.Add

exlsheet.Activate
Set exlsheet = exlsheet
exlsheet.Name = "我导出的数据"


'设置列宽
exlapp.ActiveSheet.Columns(1).ColumnWidth = 10

exlapp.ActiveSheet.Columns(2).ColumnWidth = 20


StrSql = "你的SQL语句"

Set exl_rs = PubSysCn.Execute(StrSql)

exlsheet.Range("A2").CopyFromRecordset exl_rs

exl_rs.Close
Set exl_rs = Nothing


exlapp.Worksheets("sheet1").Delete
exlapp.Worksheets("sheet2").Delete
exlapp.Worksheets("sheet3").Delete
exlapp.DisplayAlerts = True
exlapp.Caption = "数据导出完毕！！"
exlapp.Visible = True

Set exlapp = Nothing
Set exlbook = Nothing
Set exlsheet = Nothing



Exit Function

ErrorHandler:
MsgBox "EXCEL : " & err.Number & " : " & err.Description
End Function