Darren.NET

'Description：不開啟活頁簿以OLEDB Connection活頁簿,取得該活頁簿所有工作表名稱. - Ver. 1.03 'Parameters：strFullName 工作表完整路徑(路徑+活頁簿名稱), strSeparator 分隔字元 'Retrun：String 所有工作表名稱累加之字串(最後1個值為工作表數量) 'Package： 'Reference：Microsoft ActiveX Data 2.x Object Library 'Creater：Darren.NET - 2009/04/21 'Modify： Public Function F_Worksheet_GetSheetNames(strFullName As String, strSeparator As String) As String Dim cn As ADODB.Connection Dim rsT, rsC As ADODB.Recordset Dim intTblCnt, t, c As Integer Dim strTbl As String 'Dim PT As Range Dim strWsNames As String Set cn = New ADODB.Connection '創建新的ADO連結物件 '使用Jet資料庫引擎連結 With cn .Provider = "Microsoft.Jet.OLEDB.4.0" .ConnectionString = "Data Source=" & strFullName & ";Extended Properties=Excel 8.0;" .CursorLocation = adUseClient .Open End With '使用 ADO Connection 物件的 OpenSchema 方法進行擷取表格資訊 Set rsT = cn.OpenSchema(adSchemaTables) '在關聯式資料庫中可用的各種物件中 (表格、檢視、預存程序等等)， 'Excel 資料來源只會顯示相當於表格的東西， '它們是由指定活頁簿所定義的工作表和已命名範圍所組成。 '已命名範圍被視為「表格」，而工作表則被視為「系統表格」， '在這個 table_type 屬性之外，並沒有多少有用的表格資訊可以擷取。 intTblCnt = rsT.RecordCount '所有表格數 'Set PT = ActiveSheet.Range("a1") '設定顯示結果位址 'PT.Worksheet.Cells.ClearContents '先清除資料 '紀錄檔案名稱 'PT = "File:": PT.Offset(0, 1) = strFullName: Set PT = PT.Offset(2, 0) 'PT = "--------------------": Set PT = PT.Offset(1, 0) 'c = 0 '遍歷各表格 For t = 1 To intTblCnt strTbl = rsT.Fields("TABLE_NAME").Value '取得表格名稱 ' 因為範圍表格與工作表表格在資訊裡無明顯區分 ' 這裡粗略的以最後有"$"字符的, 視為工作表 If Right(strTbl, 1) = "$" Then c = c + 1 ' 列出工作表名稱 strWsNames = strWsNames & strSeparator & Mid(strTbl, 1, Len(strTbl) - 1) 'PT = "Table #" & c & ": ": PT.Offset(0, 1) = Mid(strTbl, 1, Len(strTbl) - 1) 'Set PT = PT.Offset(1, 0) End If rsT.MoveNext '下一筆 Next '紀錄工作表總數 If str(c) = "" Or str(c) = 0 Then strWsNames = strWsNames & strSeparator & c End If 'Set PT = PT.Worksheet.Range("a2"): PT = "Tables: ": PT.Offset(0, 1) = c rsT.Close '關閉資料集 cn.Close '關閉連結 End Function