Sub x()
  Dim ExcelDB As New ADODB.Connection
  Dim RS As ADODB.Recordset
  Dim S As String
 
  Set ExcelDB = New ADODB.Connection
  Set RS = New Recordset
  If Application.Version < 12 Then ExcelDB.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;  Data Source=" &  ActiveWorkbook.FullName & ";Extended Properties='Excel 8.0;HDR=No'"
  If Application.Version >= 12 Then ExcelDB.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=NO';"
  Set RS = ExcelDB.OpenSchema(adSchemaTables)
 
  Do While Not RS.EOF
     S = RS("Table_Name")
     If Left(S, 1) = "'" Then S = Mid(S, 2, Len(S) - 3) Else S = Mid(S, 1, Len(S) - 1)
     MsgBox S
     RS.MoveNext
  Loop
End Sub