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:
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:
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
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:
VBA Code:
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:
VBA Code:
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
Last edited by a moderator: