Function CheckXLFile(ByVal vstrFile As String, Optional ByRef rstrErrDescription As String) As Long
Const adOpenForwardOnly =  0 
Const adLockReadOnly =  1 
Const adOpenStatic =  3 

    Dim cat As Object
    Dim tbl As Object
    Dim cnn As Object
    Dim rs As Object
    Dim Err As Object
    Dim strConnString  As String
    Dim strSQL  As String
    Dim strError As String
    
    On Error GoTo HandleError
    Set cat = CreateObject("ADOX.Catalog")
    Set cnn = CreateObject("ADODB.Connection")
    strConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";" _
                    & "Data Source=" & vstrFile
    cnn.Open strConnString
    Set cat.ActiveConnection = cnn
    Set tbl = cat.Tables( 0 )
    If Not tbl Is Nothing Then
        Set rs = CreateObject("ADODB.Recordset")
        strSQL = "SELECT * FROM [" & tbl.Name & "]"
        rs.Open strSQL, cnn, adOpenStatic, adLockReadOnly
    End If
    rs.Close
    cnn.Close
HandleExit:
    Set tbl = Nothing
    Set rs = Nothing
    Set cat = Nothing
    Set cnn = Nothing
    Exit Function
HandleError:
    For Each Err In cnn.Errors
        rstrErrDescription = rstrErrDescription & "Error #" & Err.Number & vbCrLf & _
            "   " & Err.Description & vbCrLf & _
            "   (Source: " & Err.Source & ")" & vbCrLf & _
            "   (SQL State: " & Err.SQLState & ")" & vbCrLf & _
            "   (NativeError: " & Err.NativeError & ")" & vbCrLf
        CheckXLFile = Err.Number
    Next
    Resume HandleExit
    
End Function