macro to del specific file extension on desktop my documents subfolders with criteria

[learn72]

Hi All:hi:
Am new to vba

looking a macro to del specific files extension (xls,xlsx,xlsm,csv)on my desktop and my documents both in folders and sub folders .

except not to delete files in folder named Work found on my desktop using environ function (using windows 7)

thank if anyone can assist:crying::crying:

[YasserKhalil]

Cross-Post at this link
http://chandoo.org/forum/threads/delete-file-specific-extensions-on-my-desktop-and-my-documents-with-subfolders.35049/

[mdmackillop]

Check this in the immediate window before using the Kill line (commented out)

Sub Test()
fld = Array("DeskTop", "MyDocuments")
ftype = Array("xl*", "csv")

Dim WshShell As Object
Dim SpecialPath As String

Set WshShell = CreateObject("WScript.Shell")
For Each f In fld
pth = WshShell.SpecialFolders(f)
For Each t In ftype
p = "" & pth & "\*." & t & ""
rslt = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & p & " /b /a-d /s").stdout.readall, vbCrLf), ".")
For Each r In rslt
If InStr(1, r, "\Work\") = 0 Then
Debug.Print r
'Kill r
End If
Next r
Next t
Next f
End Sub

[YasserKhalil]

Thanks a lot Mr. mdmackillop for this nice code
I think this line would be put after "Nexr r" line


pth = WshShell.SpecialFolders(f)


I have tested that and it worked in that way

[mdmackillop]

Well spotted. The Pth = Pth & ... was incorrect. Changed to

p = "" & pth & "\*." & t & ""
and the following line accordingly.

[learn72]

Hello Mr. mdmackillop

Tried but getting a syntax error:aw

Attached file , thanks to look up where I am going wrong and advise

[mdmackillop]

Hi
"For Each" had jumped to end of previous line on formatting. Corrected above

[learn72]

Hello

Tried as per copied code as post 3 but I see cmd window working but no file deleted

See attached where may I am going wrong with a sample csv tested

[mdmackillop]

Did you remove the apostrophe from the Kill line?

Check this in the immediate window before using the Kill line (commented out)

[learn72]

Hello

Trying but still the same , code working with a cmd screen but does not delete.





Sub Test()
fld = Array("DeskTop", "MyDocuments")
ftype = Array("xl*", "csv")

Dim WshShell As Object
Dim SpecialPath As String

Set WshShell = CreateObject("WScript.Shell")
For Each f In fld
pth = WshShell.SpecialFolders(f)
For Each t In ftype
p = "" & pth & "\*." & t & ""
rslt = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & p & " /b /a-d /s").stdout.readall, vbCrLf), ".")
For Each r In rslt
If InStr(1, r, "\Work\") = 0 Then
Debug.Print r
Kill r
End If
Next r
Next t
Next f
End Sub

[mdmackillop]

It may relate to Permissions which is outwith my knowlege. Here is an alternative Delete method

Sub Test()
fld = Array("DeskTop", "MyDocuments")
ftype = Array("xl*", "csv")

Dim WshShell As Object
Dim SpecialPath As String
Dim ObjFso As Object

Set ObjFso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
For Each f In fld
pth = WshShell.SpecialFolders(f)
For Each t In ftype
p = "" & pth & "\*." & t & ""
rslt = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & p & " /b /a-d /s").stdout.readall, vbCrLf), ".")
For Each r In rslt
If InStr(1, r, "\Work\") = 0 Then
Debug.Print r
'Kill r
ObjFso.deletefile (r)
End If
Next r
Next t
Next f
End Sub