PDA

View Full Version : Loop through files in a directory and delete if not currently in use



oorickyoo
07-04-2013, 09:30 AM
Hello, I have been a long time lurker of the forum and have learned many things here.

I have tried searching, and cant find any example that really fits my current situation:

I need help writting some code that will loop through the wookbooks in a directory and delete the ones that are not in use (or opened by another user) at that time. I'm not sure where to even start with this one.

Appreciate the help!!

patel
07-04-2013, 10:30 AM
Sub excel_close_all()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\test\"
MyFile = Dir(MyFolder & "*.xls*")
While MyFile <> ""
Ret = BookOpen(MyFile)
If Ret = True Then
MsgBox "File is open"
Else
MsgBox "File is Closed"
kill MyFolder & MyFile
End If
MyFile = Dir
Stop
Wend
End Sub

Function BookOpen(wbName As String) As Boolean
On Error Resume Next
BookOpen = Len(Workbooks(wbName).Name)
End Function

oorickyoo
07-04-2013, 11:33 AM
Thanks Patel.

When run the code, with the MyFolder set to the directory I am using, I get a Run-time error '9': Subscript out of range. When I enter debug mode and hover my mouse over the (wbName) it shows me the name of the 1st file in the directory, but when I hover over the .Name it says "Workbooks(wbName).Name=<Subscript out of range>

SamT
07-04-2013, 02:49 PM
On Error Resume Next
If Len(Workbooks(wbName).Name) = 0 Then 'If it would be true, it is an error
BookOpen = False
Exit Function
Else
BookOpen = True
End If
End Sub

mancubus
07-04-2013, 02:50 PM
for network files:

http://support.microsoft.com/?kbid=138621

Paul_Hossler
07-04-2013, 05:43 PM
for network files:

http://support.microsoft.com/?kbid=138621


Thanks for the link

I often wondered how I cound tell if a file was open before I tried to open it

The sample code looks like it works for more than just network files

Paul

patel
07-04-2013, 10:34 PM
When run the code, with the MyFolder set to the directory I am using, I get a Run-time error '9': Subscript out of range.
paste here your code

snb
07-05-2013, 05:20 AM
Wouldn't this suffice ?


Sub M_snb()
on error resume next

kill "G:\OF\*.xls"
End Sub

oorickyoo
07-05-2013, 05:23 AM
This is the code that is giving me the runtime error:

Sub excel_close_all()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "E:\Dummy\LCS\Temp\"
MyFile = Dir(MyFolder & "*.xls*")
While MyFile <> ""
Ret = BookOpen(MyFile)
If Ret = True Then
MsgBox "File is open"
Else
MsgBox "File is Closed"
Kill MyFolder & MyFile
End If
MyFile = Dir
Stop
Wend
End Sub

Function BookOpen(wbName As String) As Boolean
On Error Resume Next
BookOpen = Len(Workbooks(wbName).Name)
End Function


I am going to try the other suggestions and see what happens.

Kenneth Hobs
07-05-2013, 06:13 AM
Remove Stop.

oorickyoo
07-05-2013, 06:53 AM
Remove Stop.

I removed stop and still get the same runtime error.

oorickyoo
07-05-2013, 06:57 AM
Wouldn't this suffice ?


Sub M_snb()
on error resume next

kill "G:\OF\*.xls"
End Sub


This code deletes the files until it reaches one that is open. It then generates a runtime '70' permission denied error.

oorickyoo
07-05-2013, 07:04 AM
On Error Resume Next
If Len(Workbooks(wbName).Name) = 0 Then 'If it would be true, it is an error
BookOpen = False
Exit Function
Else
BookOpen = True
End If
End Sub



This code tells me that the file is open, but still gives me the runtime '9' error once I click OK on the msgbox:

Sub excel_close_all()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "E:\Dummy\LCS\Temp\"
MyFile = Dir(MyFolder & "*.xls*")
While MyFile <> ""
Ret = BookOpen(MyFile)
If Ret = True Then
MsgBox "File is open"
Else
MsgBox "File is Closed"
Kill MyFolder & MyFile
End If
MyFile = Dir
'Stop
Wend
End Sub

Function BookOpen(wbName As String) As Boolean
On Error Resume Next
If Len(Workbooks(wbName).Name) = 0 Then 'If it would be true, it is an error
BookOpen = False
Exit Function
Else
BookOpen = True
End If
End Function

snb
07-05-2013, 09:08 AM
What with ?


Sub M_snb()
On Error Resume Next

for each it in split(createobject("wscript.shell").exec("cmd /c Dir ""G:\OF\*.xls"" /b").stdout.readall,vbcrlf)
kill "G:\OF\" & it
next
End Sub

oorickyoo
07-05-2013, 09:23 AM
What with ?


Sub M_snb()
On Error Resume Next

for each it in split(createobject("wscript.shell").exec("cmd /c Dir ""G:\OF\*.xls"" /b").stdout.readall,vbcrlf)
kill "G:\OF\" & it
next
End Sub


Again, runtime error '70' access denied, when it gets to the open file. It does delete all of the unopen files without issue.

patel
07-05-2013, 11:05 AM
Wouldn't this suffice ?


Sub M_snb()
on error resume next

kill "G:\OF\*.xls"
End Sub


this code works on my pc

SamT
07-05-2013, 11:30 AM
This code tells me that the file is open, but still gives me the runtime '9' error once I click OK on the msgbox:
You are getting "out of Range " errors on open books? Then the problem may not be in not in the BookOpen Function.

But just in case, try thisFunction BookOpen(wbName As String) As Boolean
BookOpen = Len(Workbooks(wbName).Name)
Error = 0
End Function
If that doesn't work, try thisSub excel_close_all()
Dim MyFolder As String
Dim MyFile As String
Dim Ret As Boolean
Dim ErrString As String

On Error Resume Next 'For Troubleshooting
MyFolder = "E:\Dummy\LCS\Temp\"
MyFile = Dir(MyFolder & "*.xls*")

While MyFile <> ""
On Error Go To ErrorMsg

ErrString = "Checking BookOpen"
Ret = BookOpen(MyFile)
If Ret = True Then
ErrString = "Ret is True"
MsgBox "File is open"
Else
ErrString = "Ret Is False"
MsgBox "File is Closed"
'Kill MyFolder & MyFile 'Commented out for Troubleshooting
End If
MyFile = Dir
ErrString = "Got New File"
'Stop
Wend
Exit Sub
ErrorMsg:
MsgBox ErrString & Chr(13) & "Errant file is: " & MyFile.Name
Error = 0 'Clears error
Resume

End Sub

SamT
07-05-2013, 11:42 AM
Is "E:" drive on a network computer or the computer your running this code on?

oorickyoo
07-05-2013, 12:38 PM
E:\ is a local drive on the PC i am running the code from

snb
07-05-2013, 01:19 PM
It does delete all of the unopen files without issue

Isn't that you were after ?