Ordner löschen Zugriff verweigert

Sub test()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim qpath As String, zpath As String, afolder As String, astring As String
'aktuellen Pfad detzen
qpath = ThisWorkbook.Path
'Pfad 1 Ebene höher ermitteln
Dim stellen, go_on As Long
stellen = 0
go_on = 0
'Oberordner ermitteln
path_lenght = Len(qpath)
For i = path_lenght To 1 Step -1
If go_on = 0 Then
If (Mid(qpath, i, 1))  "\" Then
stellen = stellen + 1
Else
go_on = 1
End If
End If
Next i
'Pfad ermitteln
zpath = Left(qpath, Len(qpath) - stellen)
afolder = Right(qpath, stellen) & "\"
'Ordner löschen sofern vorhanden
If Dir(zpath & "\backup_rollout\" & afolder, vbDirectory)  "" Then
Set f = FSO.GetFolder(zpath & "\backup_rollout\" & afolder)
f.Delete
End If
Set FSO = Nothing
End Sub