Permission Denied while trying to delete folder FileSystemObject

[jaryszek]

Hi Guys,

this is crosspost from here:

Permission Denied while trying to delete folder FileSystemObject

I am using this code to copy folders and delete old ones:

Sub ExportBundleAtOnceMultipleFolders147()

Dim boolXLSX As Boolean
Dim myExtension As String
Dim WB As Workbook
Dim FSO As Object
Dim FSOFolder As Object
Dim FSOFile As Object
Dim vbProj As Object
Dim targetFolder As String
Dim FolderMig As String
Dim FolderTab As String, path As String
Dim wshTempOld As Worksheet, wshTemp As Worksheet
Dim lstrow, lstcolumn As Long
Dim oQT As QueryTable
Dim currentBundle As String
Dim FSOFolderToCopy As String
Dim ColFolders As New Collection
'call SaveNamedRangesMacro(

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set WB = ThisWorkbook

'    With Application.FileDialog(msoFileDialogFolderPicker)
'        .Title = "Choose Folder with Old Multiple Bundles to Migrate"
'        If .Show = -1 Then ' if OK is pressed
'            targetFolder = .SelectedItems(1)
'        End If
'    End With

'    With Application.FileDialog(msoFileDialogFolderPicker)
'        .Title = "Choose CurrentBundle"
'        If .Show = -1 Then ' if OK is pressed
'            currentBundle = .SelectedItems(1)
'        End If
'    End With

currentBundle = "MYPath"
   
targetFolder = "MYPath2"

If targetFolder = "" Then MsgBox "Choose folder, macro cancelled": GoTo resetSettings
   
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSO.GetFolder(targetFolder)
Dim FSOvFolder As Variant
   
'Target File Extension (must include wildcard "*")
myExtension = ".csv"

'Use For Each loop to loop through each file in the folder
For Each FSOvFolder In FSOFolder.SubFolders

ColFolders.Add FSOvFolder
       ''locate bundle
If Len(Dir(FSOvFolder & "\" & "BundleExport", vbDirectory)) = 0 Then
    MsgBox "BundleExport not exists in location: " & FSOvFolder
    GoTo resetSettings
Else
     FolderMig = FSOvFolder & "\" & "BundleExport"
End If
      
FSO.Copyfolder FSOvFolder, FSOvFolder & "_Old"

FSOvFolder = FSOvFolder & "_Old"
      
If Len(Dir(FolderMig & "\" & "Myin", vbDirectory)) = 0 Then
    MsgBox "Myin not exists in location: " & FolderMig
    GoTo resetSettings
Else
     FolderTab = FSOvFolder & "\" & "BundleExport" & "\" & "Myin"
End If

FSO.Copyfolder Left(currentBundle, Len(currentBundle) - 1), Left(FSOvFolder, InStr(1, FSOvFolder, "_Old") - 1) & "_Updated"
FSO.Copyfolder Left(FolderTab, Len(FolderTab) - 1), Left(FSOvFolder, InStr(1, FSOvFolder, "_Old") - 1) & "_Updated" & "/" & "Myin"

Next FSOvFolder

Set FSOFolder = Nothing

Dim vitem As Variant
Dim queue As Collection
Dim oFolder As Object
Dim oSubFolder As Variant
Dim FoldersToDelete As New Collection
Dim oFile As Variant
Dim i As Long

For Each vitem In ColFolders

   Set queue = New Collection
   queue.Add FSO.GetFolder(vitem) 'obviously replace
  
    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1 'dequeue
        FoldersToDelete.Add oFolder
        '...insert any folder processing code here...
        For Each oSubFolder In oFolder.SubFolders
            queue.Add oSubFolder 'enqueue
        Next oSubFolder
        For Each oFile In oFolder.Files
            oFile.Delete
        Next oFile
    Loop
   
    Set FSO = Nothing
   
    For i = FoldersToDelete.Count To i = 1 Step -1
    If FoldersToDelete(i).Attributes And 1 Then '1 = ReadOnly
        FoldersToDelete(i).Attributes = FoldersToDelete.Attributes - 1
    End If
        FoldersToDelete(i).Delete
    Next i
   
Next vitem

MsgBox "Done!"
Set FSO = Nothing
GoTo resetSettings

Exit Sub
resetSettings:

On Error Resume Next
    wshTemp.Delete
    wshTempOld.Delete
On Error GoTo 0

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
   
End Sub

The issue that i can not after this macro delete folder manually from disk (i have to save Excel for this).
I have noticed that his function:

If Len(Dir(FolderMig & "\" & "Myin", vbDirectory)) = 0 Then
    MsgBox "Myin not exists in location: " & FolderMig
    GoTo resetSettings
Else
FolderTab = FSOvFolder & "\" & "BundleExport" & "\" & "Myin\"
End If

is causing the issue. After commenting it i can delete folder without any problems.

Why? Can anynody try to use similar code and dir function to delete folder?
Please i am asking only to use the similar approach and check why this is happening?

Best Wishes,
Jacek

 

[jaryszek]

Hi,

up

 

[RoryA]

Which folder(s) can't you delete? It's not obvious to me at first glance why that Dir would cause a problem, especially if the one prior to it doesn't.

 

[jaryszek]

i adjusted macro a little to show you what i mean (and adding example here : Permission Denied while trying to delete folder FileSystemObject)

Code:

Option Explicit

Sub ExportBundleAtOnceMultipleFolders147()

Dim boolXLSX As Boolean
Dim myExtension As String
Dim WB As Workbook
Dim FSO As Object
Dim FSOFolder As Object
Dim FSOFile As Object
Dim vbProj As Object
Dim targetFolder As String
Dim FolderMig As String
Dim FolderTab As String, path As String
Dim wshTempOld As Worksheet, wshTemp As Worksheet
Dim lstrow, lstcolumn As Long
Dim oQT As QueryTable
Dim currentBundle As String
Dim FSOFolderToCopy As String
Dim ColFolders As New Collection
'call SaveNamedRangesMacro(

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set WB = ThisWorkbook

currentBundle = "C:\Users\admin\Desktop\Example\CurrentBundle\"
targetFolder = "C:\Users\admin\Desktop\Example\TargetFolder\"

If targetFolder = "" Then MsgBox "Choose folder, macro cancelled": GoTo resetSettings
   
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSO.GetFolder(targetFolder)
Dim FSOvFolder As Variant
   
'Target File Extension (must include wildcard "*")
myExtension = ".csv"

'Use For Each loop to loop through each file in the folder
For Each FSOvFolder In FSOFolder.SubFolders

ColFolders.Add FSOvFolder
       ''locate bundle
If Len(Dir(FSOvFolder, vbDirectory)) = 0 Then
    MsgBox "BundleExport not exists in location: " & FSOvFolder
    GoTo resetSettings
Else
     FolderMig = FSOvFolder
End If
      
FSO.Copyfolder FSOvFolder, FSOvFolder & "_Old"

FSOvFolder = FSOvFolder & "_Old"
      
If Len(Dir(FolderMig & "\" & "Myin", vbDirectory)) = 0 Then
    MsgBox "Myin not exists in location: " & FolderMig
    GoTo resetSettings
Else
     FolderTab = FSOvFolder & "\" & "Myin"
End If

FSO.Copyfolder Left(currentBundle, Len(currentBundle) - 1), Left(FSOvFolder, InStr(1, FSOvFolder, "_Old") - 1) & "_Updated"
'FSO.Copyfolder Left(FolderTab, Len(FolderTab) - 1), Left(FSOvFolder, InStr(1, FSOvFolder, "_Old") - 1) & "_Updated" & "/" & "Myin"

Next FSOvFolder

Set FSOFolder = Nothing

Dim vitem As Variant
Dim queue As Collection
Dim oFolder As Object
Dim oSubFolder As Variant
Dim FoldersToDelete As New Collection
Dim oFile As Variant
Dim i As Long

For Each vitem In ColFolders

    FSO.DeleteFolder vitem
   
Next vitem

MsgBox "Done!"
Set FSO = Nothing
GoTo resetSettings

Exit Sub
resetSettings:

On Error Resume Next
    wshTemp.Delete
    wshTempOld.Delete
On Error GoTo 0

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
   
End Sub

And now:

Create 2 folders:

And in Target Folder i have BundleExport Folder where i have subfolder Myin and inside it i created samples files:

now provide your local paths and run macro.
You will ger error permission danied on this line:

For Each vitem In ColFolders

    FSO.DeleteFolder vitem
   
Next vitem

exactly this folder can not be deleted:

C:\Users\admin\Desktop\Example\TargetFolder\BundleExport

so why not? Why this error occurs?

Please help,
Jacek

 

[jaryszek]

Just insert this line before above loop with deleting folder:

Debug.Print Len(Dir(WB.path, vbDirectory))

and after this this will work like a charm

 

[RoryA]

If I can bring myself to use code with a Goto in it, I'll have a look later...

 

[jaryszek]

Why not to use Goto ?
This is error handler.
Uou are using only on error resume net and on error goto 0?

Thanks!

Jacek

 

[RoryA]

Goto on its own is not an error handler. It's usually just a recipe for horrendous code.

 

[jaryszek]

Rory, how to avoid it?
Can you advice how to write code without goto?

i think that many experts would argue with your statement.

Jacek

 

[RoryA]

Show me one?