@Nukepayload2

工作表有名字？不是文件名吗？
---贴吧极速版 For UWP

你指的是sheet1 2 3那些吗

Private Sub Command3_Click()
On Error GoTo MyError
Dim cat As Object '数据库对象
Dim cn As Object '数据连接对象
Dim tbl As Object '数据表对象
Dim xlssql As String
Set cn = CreateObject("ADODB.Connection")
Set cat = CreateObject("ADOX.Catalog")
SheetName = Combo1.Text
If Len(SheetName) = 0 Then
MsgBox "请输入工作表(Sheet)名称", vbInformation, "温馨提示"
Exit Sub
End If
With cdlg
.Filter = "Excel 97-2003工作簿(*.xls)|*.xls|Excel 工作簿(*.xlsx)|*.xlsx"
.DialogTitle = "选择导入文件"
.InitDir = App.Path
.FileName = ""
.ShowOpen
ImportFile = .FileName
End With
If Len(ImportFile) > 0 Then
Debug.Print "filename=" & ImportFile
Text1.Text = ImportFile
DoEvents
'获取sheet名称
If InStr(ImportFile, "xlsx") > 0 Then
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ImportFile & _
";Extended Properties='Excel 12.0 Xml;HDR=Yes;IMEX=1'"
Else
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ImportFile & _
";Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
End If
Set cat.ActiveConnection = cn
Combo1.Clear
For Each tbl In cat.Tables
Debug.Print tbl.Name
If InStr(tbl.Name, "$") > 0 Then
Combo1.AddItem tbl.Name
End If
Next
Combo1.Text = "请选择数据表名称"
Set tbl = Nothing
Set cat = Nothing
Set cn = Nothing
End If
MyError:
If Err.Number = 0 Then Exit Sub
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "错误"
End Sub

@闪星2 我根据你的代码做了相关修改，但结果是这样的
修改后的代码：
Try
Dim cat As Object
Dim cn As Object
Dim tbl As Object
Dim xlssql As String
cn = CreateObject("provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & Me.ListBox1.SelectedItems(n))
cat = CreateObject(Me.ListBox1.SelectedItems(n))
Debug.Print("filename=" & Me.ListBox1.SelectedItems(n))
If InStr(Me.ListBox1.SelectedItems(n), "xlsx") > 0 Then
cn.Open("Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Me.ListBox1.SelectedItems(n) & ";Extended Properties='Excel 12.0 Xml;HDR=Yes;IMEX=1'")
Else
cn.Open("Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Me.ListBox1.SelectedItems(n) & ";Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'")
End If
cat.ActiveConnection = cn
For Each tbl In cat.Tables
Debug.Print(tbl.Name)
If InStr(tbl.Name, "$") > 0 Then
Me.ListBox2.Items.Add(tbl.Name)
End If
Next
tbl = Nothing
cat = Nothing
cn = Nothing
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "工作表读取失败")
End Try
其中的Me.ListBox1.SelectedItems(n)是指下面这个

调用Microsoft Excel XX Object Library组件就可以了
Imports Microsoft.Office.Interop
Private Sub testSub()
Dim xlApp = New Excel.Application
Dim xlBook = xlApp.Workbooks.Open("Excel文件路径")
For Each sheet As Excel.Worksheet In xlBook.Sheets
MsgBox(sheet.Name)
Next
End Sub

cn = CreateObject("ADODB.Connection")
cat = CreateObject("ADOX.Catalog")
这里酱紫改就可以了呀

‘获取当前 excel 文件名：
Private Sub command1_click()
Dim xl As Object ' New Excel.Application '
Dim xlBook As Object ' Workbook
Set xl = GetObject(, "Excel.Application")
Set xlBook = xl.ActiveWorkbook
Debug.Print xlBook.Path & "\" & xlBook.name '立即窗口显示
msgbox xlBook.Path & "\" & xlBook.Name '弹窗显示
end sub

好东西