Hi BillyRogers

Try this one  for the folder C:\Data
It will only check the xls files

Sub Test()
   Dim MyPath As String
   Dim FilesInPath As String
   Dim MyFiles() As String
   Dim Fnum As Long
   Dim mybook As Workbook
   Dim basebook As Workbook

   'Fill in the path\folder where the files are
   MyPath = "C:\Data"    'or "\\Username\SharedDocs"
   'Add a slash at the end if the user forget
   If Right(MyPath, 1) <> "\" Then
       MyPath = MyPath & "\"
   End If

   'If there are no Excel files in the folder exit the sub
   FilesInPath = Dir(MyPath & "*.xls")
   If FilesInPath = "" Then
       MsgBox "No files found"
       Exit Sub
   End If

   On Error GoTo CleanUp
   Application.ScreenUpdating = False

   Set basebook = ThisWorkbook
   'Fill the array(myFiles)with the list of Excel files in the folder
   Fnum = 0
   Do While FilesInPath <> ""
       Fnum = Fnum + 1
       ReDim Preserve MyFiles(1 To Fnum)
       MyFiles(Fnum) = FilesInPath
       FilesInPath = Dir()
   Loop

   'Loop through all files in the array(myFiles)
   For Fnum = LBound(MyFiles) To UBound(MyFiles)
       Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))

       If mybook.Worksheets.Count < 2 Then
           mybook.ChangeFileAccess xlReadOnly
           Kill mybook.FullName
           mybook.Close False
       Else
           mybook.Close False
       End If

   Next Fnum

CleanUp:
   Application.ScreenUpdating = True
End Sub