Delete Files with less than 2 sheets

[BillyRogers]

I'm tring to write a macro that loops through a folder on my computer and
deletes all the worksheets that have only 1 sheet in the workbook. I would
also like to have the procedure delete any non .xls files too if possible.
Does anyone have any ideas? Is this possible?

Thanks

[Ron de Bruin]

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


--
Regards Ron de Bruin
http://www.rondebruin.nl


"BillyRogers" <BillyRogers@discussions.microsoft.com> wrote in message news:35E0D74B-3A85-400E-864A-407DAF9F4A3B@microsoft.com...
> I'm tring to write a macro that loops through a folder on my computer and
> deletes all the worksheets that have only 1 sheet in the workbook. I would
> also like to have the procedure delete any non .xls files too if possible.
> Does anyone have any ideas? Is this possible?
>
> Thanks

[BillyRogers]

Ron,

You are the BEST!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

I am amazed!!!!

Thank you so much