Code Help

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

here is my code currently

Public Function DeleteReports2()
On Error GoTo errTrap
Dim rtfPath As String


rtfPath = "X:\Distribution Projects\XL\"
Kill rtfPath & "CCGA.xls"
rtfPath = "X:\Distribution Projects\XL\"
Kill rtfPath & "MTEN.xls"
rtfPath = "X:\Distribution Projects\XL\"
Kill rtfPath & "NPAT.xls"
rtfPath = "X:\Distribution Projects\XL\"
Kill rtfPath & "MWCT.xls"



exitTrap:
On Error Resume Next
Exit Function
errTrap:
Select Case Err.Number
Case Is = 53
MsgBox "No files to delete in folder: " & vbCrLf & rtfPath,
vbExclamation
Resume exitTrap


Case Else
MsgBox Err.Number & " " & Err.Description, vbCritical
Resume exitTrap
End Select
End Function



the problem is that if one of the .xls files aren't out there then the code
bombs out -- i want this to delete the files out in the folder (all but one
file - template) and if the files are not out there to continue on to the
other files

Please help!
Thank you
 
Change the Resume statement in the Select Case in the error trap to resume
with the next file.
Select Case Err.Number
Case Is = 53
MsgBox "No files to delete in folder: " & vbCrLf & rtfPath,
vbExclamation
Resume Next 'change this line
 
You need to check if the file exists in the first place, before attempting to
delete it.

rtfPath = "X:\Distribution Projects\XL\"
If Dir(rtfPath & "CCGA.xls") <> "" Then
Kill rtfPath & "CCGA.xls"
EndIf

Hope this helps.
 
This should do it - adjust it as necessary. It currently asks for the path,
the extension (i.e. ".xls") and then deletes every Excel file except
"template.xls" - obviously change this to the name of your own template (and
you shouldn't have to include this If statement at all if you have ".xlt" as
your template's extension).

PLEASE TEST IT ON A DUMMY FOLDER OF TEST FILES FIRST! (This is dangerous
code!!)

Sub DeleteExcelFiles()
Dim myPath As String
Dim myExt As String
myPath = InputBox("Path (including final \)?")
myExt = InputBox("File extension?", , ".xls")
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(myPath)
Set fc = f.Files
For Each f1 In fc
If LCase(Right(Trim(f1.Name), 4)) = myExt Then
If f1.Name <> "template.xls" Then
Kill myPath & f1.Name
End If
End If
Next
End Sub
 
Back
Top