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

[1ssp]

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: TABLE

Table name: 滨洲市$_
Table type: TABLE

Table name: 荷泽市$
Table type: TABLE

Table name: 济南市$
Table type: TABLE

Table name: 聊城市$
Table type: TABLE
上面出现了两次滨洲市,事实上只有一个"滨洲市"工作表.
急用,谢谢

[xinliangyu]

遇到过类似问题，也没搞清楚是怎么回事。有时工作表名最后两个字符会是“$'”,即货币符号后跟个撇号

[faysky2]

用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

[faysky2]

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

[hhjjhjhj]

很多情况会出现这现象
如:自定义名称(插入---名称---定义)
列表(数据---列表)
数据透视表
导入外部数据(数据库查询)
等.

[DawnPine]

看来是个普遍问题

[of123]

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 Long

Private 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

[of123]

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

[yanro]

'***********************************************************************/
'* 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