Answer 1

我不知道它是否可以直接完成，但有兴趣看看是否有人回来使用工作方法。 ADO的GetSchema集合似乎只获取了表名和命名范围，而不是命名表的ListObject。下面是一种解决方法，但它意味着打开Excel以查找表的标题/数据范围。使用ADO或类似的几乎没有意义，因为你可以直接复制数据，但我想你可以在保存为一次性任务之前转换为命名范围？

Option Explicit

Sub test()
Dim WB As Workbook, WS As Worksheet, strExcelfile As String, strSheetName As String
Dim strTableName As String, objListObj As ListObject, HeaderRange As String
Dim strSQL As String, DataRange As String

strExcelfile = "C:\Users\osknows\Desktop\New folder\test.xlsm"
strSheetName = "Sheet1"
strTableName = "TableName"


Set WB = GetObject(strExcelfile) 'Filepath & Filename
Set WS = WB.Sheets(strSheetName) 'SheetName
Set objListObj = WS.ListObjects(strTableName) 'Table Name

'get range of Table
HeaderRange = objListObj.HeaderRowRange.Address
DataRange = objListObj.DataBodyRange.Address

'write data directly if required
With ThisWorkbook
    With Sheet1
    '.Range(HeaderRange).Value = WS.Range(HeaderRange).Value
    '.Range(DataRange).Value = WS.Range(DataRange).Value
    End With
End With

'or use ADODB which is a bit pointless now!
Dim cnn1 As New ADODB.Connection
Dim rst1 As New ADODB.Recordset

cnn1.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & strExcelfile & ";" & _
    "Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"

strSQL = "SELECT * FROM [" & strSheetName & "$" & Replace(DataRange, "$", "") & "];"
rst1.Open strSQL, cnn1, adOpenStatic, adLockReadOnly


'tidy up
Set objListObj = Nothing
Set WS = Nothing
WB.Close
Set WB = Nothing
End Sub