如何在vba中用ADOX.Catalog获取excel文件的工作表名称？

Sub QQ1722187970()
    Dim sFN As String
    sFN = Excel.Application.GetOpenFilename()
    If Len(sFN) Then
        Dim arrName()
        Dim objCatalog
        Set objCatalog = VBA.CreateObject("ADOX.Catalog")
        Dim sVersion As String
        sVersion = Excel.Application.Version
        Dim sConStr As String
        '创建连接字符串
        If sVersion <= 12 Then
            sConStr = "Provider='Microsoft.Jet.OLEDB.4.0';Data Source=" & sFN & ";Extended Properties='Excel 8.0;HDR=YES'"
        Else
            sConStr = "Provider='Microsoft.ACE.OLEDB.12.0';Data Source=" & sFN & ";Extended Properties='Excel 12.0;HDR=YES'"
        End If
        Dim oConStr
        Set oConStr = CreateObject("ADODB.Connection")
        '使用Connection连接数据源
        oConStr.Open sConStr
        With objCatalog
            '关联Connection对象
            Set .ActiveConnection = oConStr
            Dim oTable
            For Each oTable In .Tables
                Dim sName As String
                sName = oTable.Name
                '提取工作表名称
                If Right(sName, 1) = "$" Then
                    Debug.Print sName
                    ReDim Preserve arrName(k)
                    arrName(k) = Left(sName, Len(sName) - 1)
                    k = k + 1
                End If
            Next
        End With
        Set oConStr = Nothing
    End If
End Sub