Dim fname As String
    fname = GetExcelFileName(Me.Hwnd)
    If fname = "" Then Exit Sub
    
    Dim Cnn As ADODB.Connection
    Dim rS As ADODB.Recordset
    
    Set Cnn = New ADODB.Connection
    Set rS = New ADODB.Recordset
    
    Cnn.Open "Driver={Microsoft Excel Driver (*.xls)};DBQ=" & fname & ";ReadOnly=1"
    
    CurrentDb.Execute "DELETE * FROM tblTempSheets"
    
    Dim tn As String
    Set rS = Cnn.OpenSchema(adSchemaTables)
    Do While Not rS.EOF
        tn = rS("TABLE_NAME")
        If Left(tn,  1 ) = "'" Then tn = Mid(tn,  2 )
        If Len(tn) < InStr( 1 , tn, "$") +  2  Then
            tn = Left(tn, InStr( 1 , tn, "$") -  1 )
            CurrentDb.Execute "INSERT INTO tblTempSheets(SheetName) VALUES ('" & tn & "')"
        End If
        rS.MoveNext
    Loop
    rS.Close
    Cnn.Close

...
Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & txtExcelName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"""
rS.Open "SELECT * FROM [" & ListItem & "$];", Cnn, adOpenStatic, adLockOptimistic
rS.MoveLast
rS.MoveFirst
Do While Not rS.EOF
     ...
     rS.MoveNext
Loop
...