利用ADO的OpenSchema方法在不打开xls文件情况下获取Sheet名集合

yehf

需引用ADO库,此法不能打开带有密码的xls文件
Public Function GetTableName(DataBaseName As String)
    Dim strcnn As String
    Dim TableSet As ADODB.Recordset
    Dim con As New ADODB.Connection
    Dim DataBaseType As String
    Select Case Right(DataBaseName, 3)
    Case "xls"
        DataBaseType = "Excel Files"
    Case "mdb"
        DataBaseType = "MS Access Database"
    End Select
    strcnn = "DSN=" & DataBaseType & ";dbq=" & DataBaseName
    con.Open strcnn
    Set TableSet = con.OpenSchema(adSchemaTables)
    Do Until TableSet.EOF
        GetTableName = GetTableName & TableSet!table_name & ","
        TableSet.MoveNext
    Loop
    GetTableName = Left(GetTableName, Len(GetTableName) - 1)
    con.Close
    Set gconnection = Nothing
End Function

鱼儿游游

我试过此方法，如工作表名是中文，有时会出错(不是每次都出错，令人纳闷)，返回的工作表名的第一个字符是“？”
后来，我改用打开EXCEL文件的方法，没再出现上述问题。


    '打开Excel文件
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelBook = objExcelApp.Workbooks.Open(strExcelFileName, , True)
    strSheetList=""
    For Each objExcelSheet In objExcelBook.Worksheets
          strSheetList=strSheetList &  objExcelSheet.Name & ","
    Next

yehf

鱼儿游游 发表于 2011-10-14 16:20
我试过此方法，如工作表名是中文，有时会出错，返回的工作表名的第一个字符是“？”

多谢提醒,我再测试下

tanhong

我好象没遇到过

yehf

改用ADOX的Catalog对象试试
Public Function GetTableName(FileName As String)  
'需引用Microsoft ADO .Ext各版本
    Dim cnn    As New ADODB.Connection
    Dim mycat  As New ADOX.Catalog
    Dim i As Integer
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        If Right(FileName, 4) = ".xls" Then _
        .Properties("extended properties").Value = "excel 8.0"           '文件为xls,增加连接词
        .Open FileName
    End With
    mycat.ActiveConnection = cnn
    For i = 0 To mycat.Tables.Count - 1
        If Left(mycat.Tables.Item(i).Name, 4) <> "MSys" Then
            Debug.Print mycat.Tables.Item(i).Name
        End If
    Next i  
    Set mycat = Nothing
    cnn.Close
    Set cnn = Nothing
End Function