• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 300
  • Last Modified:

Delete folders in Windows XP from Excel using VBA

Dear Experts:

I wonder whether I am able to delete folders using an Excel macro?

I got a parent folder named C:\parentfolder...

Below this parent folder  are many subfolders and sub-subfolders etc.

Many of these folders (they are always located on the lowest level) are called 'JPEG' and they all! need to be deleted.

Is this possible.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
0
Andreas Hermle
Asked:
Andreas Hermle
  • 10
  • 4
  • 3
2 Solutions
 
MacroShadowCommented:
Option Explicit

Function DeleteFolders(ByVal strDir As String, ByVal strFolderName As String)

    Dim oFS As Object
    Dim oDir, oSub

    Set oFS = CreateObject("Scripting.FileSystemObject")
    Set oDir = oFS.GetFolder(strDir)

    For Each oSub In oDir.SubFolders
        If oSub.Path = strDir & "\" & strFolderName Then
            oFS.DeleteFolder oSub
        End If
    Next oSub

    For Each oSub In oDir.SubFolders
        Call DeleteFolders(oSub.Path)
    Next oSub
    
End Function

Open in new window


Call it like this:
Call DeleteFolders("C:\ParentFolder\", "JPEG")

Open in new window

0
 
byundtCommented:
The preceding macro is case sensitive, and won't delete a folder named "jpeg"

This code is not case sensitive, and also lets you choose the parent folder using a file browser.
Dim fso As Object

Sub RmDirJPEG()
'Removes all folders and subfolders nuamed JPEG
Dim fldr As Object
Dim sPath As String
sPath = Application.GetOpenFilename("All files (*.*),*.*", Title:="Select any file in parent folder")
If sPath = "False" Then Exit Sub
sPath = Left(sPath, InStrRev(sPath, Application.PathSeparator) - 1)
Set fso = CreateObject("Scripting.FileSystemObject")

Set fldr = fso.GetFolder(sPath)
DeleteFolder fldr
Set fldr = Nothing
Set fso = Nothing
End Sub

Sub DeleteFolder(fldr As Object)
Dim SubFldr As Object
Dim sPath As String
sPath = fldr.Path
For Each SubFldr In fldr.SubFolders
    DeleteFolder SubFldr
Next
If UCase(fldr.Name) = "JPEG" Then
    fso.DeleteFolder fldr
End If
End Sub

Open in new window

Brad
0
 
MacroShadowCommented:
To deal with the issues mentioned by Brad I would use the following variation of my original code:
Option Explicit

Function DeleteFolders(ByVal strFolderName As String, Optional ByVal strDir As String)

    Dim oFS As Object
    Dim oDir, oSub
    Dim strPath As String

    Set oFS = CreateObject("Scripting.FileSystemObject")
    Set oDir = oFS.GetFolder(strDir)

    If Len(strDir) < 1 Then
        strPath = SelectFolder("C:\")
    End If

    For Each oSub In oDir.SubFolders
        If UCase(oSub.Path) = UCase(strDir) & "\" & UCase(strFolderName) Then
            oFS.DeleteFolder oSub
        End If
    Next oSub

    For Each oSub In oDir.SubFolders
        Call DeleteFolders(oSub.Path)
    Next oSub

End Function

Function SelectFolder(Optional strStartDir As String) As String
    Dim SA As Object, f As Object
    Set SA = CreateObject("Shell.Application")
    If Len(strStartDir) > 1 Then
        Set f = SA.BrowseForFolder(0, "Choose a folder", 16 + 32 + 64, strStartDir)
    Else
        Set f = SA.BrowseForFolder(0, "Choose a folder", 16 + 32 + 64)
    End If
    If (Not f Is Nothing) Then
        SelectFolder = f.Items.Item.Path
    End If
    Set f = Nothing
    Set SA = Nothing
End Function

Open in new window


To call the function use either this (where you pass the parent folder as a parameter):
Call DeleteFolders("JPEG", "C:\ParentFolder\")

Open in new window

Or this (where the user selects the parent folder using a folder picker):
Call DeleteFolders("JPEG")

Open in new window

0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Andreas HermleTeam leaderAuthor Commented:
As always, I am very impressed at the fantastic support a user gets if he turns to EE for help.

I will do some testing and then let you know.

Thank you very much.

Regards, andreas
0
 
Andreas HermleTeam leaderAuthor Commented:
Hi Brad,

again, thank you very much for your great help. I am afraid to tell you that the code throws an error message on line 26: Runtime Error 70 Permission Denied.

Any idea why?

Regards, Andreas
0
 
byundtCommented:
Are the files in question Read-only or is the folder marked Read-only?

As a workaround for the above possibilities, you might consider adding the optional second parameter to that statement:
    fso.DeleteFolder fldr, True        'The True means to delete the folder even if read-only
0
 
Andreas HermleTeam leaderAuthor Commented:
Hi Macro Shadow:

I am calling the function as follows:

Sub CallingFunction()
Call DeleteFolders("JPEG")
End Sub

I am afraid to tell you that I am receiving an error message on line 10 of your revised code:
Invalid Procedure call or argument, Runtime Error 5

Any idea why?

Regards, Andreas
0
 
Andreas HermleTeam leaderAuthor Commented:
Hi Brad,

thank you very much for your swift support.

ok, this must be the cause:

The check box next to the 'Read Only' Option in the Properties menu is checked and grayed out, hence it seems I don't have permission to change it.

Strangely, I can delete the folder by pressing Delete.

Anyhow, even by substituting  'fso.DeleteFolder fldr, True' the error messages keeps appearing.

Regards, Andreas
0
 
MacroShadowCommented:
My bad. I will be posting a working version shortly.
0
 
Andreas HermleTeam leaderAuthor Commented:
Hi MacroShadow,

take your time, there is no need to rush. But as you can see from the thread, I am obviously having problems to have folders deleted due to read-only protection, although I can delete folders manually

Anyhow, I give the codes a try on my private computer.

Regards, Andreas
0
 
MacroShadowCommented:
Not optimized (works pretty slow for directories that contain many sub-folders) will work on optimization later.
Function DeleteFolders(ByVal strFolderName As String, Optional ByVal strDir As String)

    Dim oFS As Object
    Dim oDir, oSub
    Dim strPath As String
On Error Resume Next
    Set oFS = CreateObject("Scripting.FileSystemObject")

    If Len(strDir) = 0 Then
        strPath = SelectFolder("C:\")
    Else
        strPath = strDir
    End If
    
    If Len(strPath) = 0 Then Exit Function
    
    Set oDir = oFS.GetFolder(strPath)

    For Each oSub In oDir.SubFolders
        If UCase(oSub.Path) = UCase(strPath) & "\" & UCase(strFolderName) Then
            oFS.DeleteFolder oSub
        End If
    Next oSub

    For Each oSub In oDir.SubFolders
        Call DeleteFolders(strFolderName, oSub.Path)
    Next oSub

End Function

Function SelectFolder(Optional strStartDir As String) As String
    Dim SA As Object, f As Object
    Set SA = CreateObject("Shell.Application")
    If Len(strStartDir) > 1 Then
        Set f = SA.BrowseForFolder(0, "Choose a folder", 16 + 32 + 64, strStartDir)
    Else
        Set f = SA.BrowseForFolder(0, "Choose a folder", 16 + 32 + 64)
    End If
    If (Not f Is Nothing) Then
        SelectFolder = f.Items.Item.Path
    End If
    Set f = Nothing
    Set SA = Nothing
End Function

Open in new window

0
 
Andreas HermleTeam leaderAuthor Commented:
Hi MacroShadow,

I am impressed. Works like a charm. Great. Saves me hours of time. I do not find it slow at all. Thank you very much for your great coding expertise

Brad:
Since MacroShadow's code is running fine, the runtime error that is thrown up must have some other cause, BUT I have to stress, I have received so many good working codes from you so far (I'd say at least 50 or 60) ,  this code is the first one where an error message occurred. And I am sure you will find out, why this is so!

Regards, Andreas
0
 
byundtCommented:
Andreas,
I'm not able to reproduce your problem with Windows 7, so maybe it's a difference with Windows XP, or perhaps the folder in question belongs to an Administrative account.

The only difference I can see between MacroShadow's successful code and my unsuccessful one is this statement at the beginning:
On Error Resume Next

Open in new window

Does the folder that causes a problem in my code get deleted by MacroShadow's code? I'm thinking that it might not.

Brad
0
 
Andreas HermleTeam leaderAuthor Commented:
Hi Brad,

I re-tested it. MacroShadow's code works fine on any folder I tried. Yes, this is really strange. I will give it a try on my personal computer and then let you know.

Regards, Andreas


Again, thank you very much for your great support.
0
 
Andreas HermleTeam leaderAuthor Commented:
Brad:

I was gonna test it yesterday, but did not find time. It'll be today and then I will get back to you.

Regards, Andreas
0
 
Andreas HermleTeam leaderAuthor Commented:
Hi Brad,

this is really weird. Your macro works on my home computer but not at my working place. MacroShadow's code work on both, hence I guess, I will now proceed to the awarding of points and award more points to MacroShadow's code. I am sure you will understand this.

Thank you very much to both of you.

Regards, Andreas
0
 
Andreas HermleTeam leaderAuthor Commented:
Dear both,

thank you very much for your professional support. I really appreciate your work.

Regards, Andreas
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 10
  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now