RawlinsCross
Active Member
- Joined
- Sep 9, 2016
- Messages
- 437
My apologies for the verbose title. I have a group of 4 folders whose names I alter through VBA. However, if I open one of those folders programmatically, it will subsequently not allow me to rename that particular folder either programmatically or manually (in file explorer) until I shut down my excel. When I restart my excel, it works perfectly as long as I do not open the folder through VBA. So it's like Excel is taking hold of that folder when I open it through excel and doesn't return it (error: Permission Denied when I try to remain it through VBA). Has anyone come across this?
Here's my code:
Here is the code that stores or views files. If I don't run this code the above code works perfectly. If I "Open" any files, that's when the above code fails.
Here's my code:
VBA Code:
Dim oFSO As Object, mySource As Object, folder As Variant
Dim lNewItemNum As Long
Dim sMyPath As String, sPrefix As Stringt
Dim lNewNum As Long
Dim sNewName As String
Set mwSht = ThisWorkbook.Worksheets("Settings")
Set mrRange = mwSht.Range("FolderLocation")
sMyPath = mrRange.Value & "\" & Me.cbType & "\" & Me.tbCharterID
Set oFSO = CreateObject("Scripting.FileSystemObject")
If DirectoryExists(sMyPath) = False Then
oFSO.CreateFolder sMyPath
End If
Set mySource = oFSO.GetFolder(sMyPath)
'MOVE / REARRANGE
If sMode = "Rearrange" Then
For Each folder In mySource.subFolders
lNewItemNum = moDelivFinalDict(folder.Name)
sPrefix = Left(folder.Name, 18)
sNewName = sPrefix & Format(lNewItemNum, "000") & "A"
folder.Name = sNewName '<-----------------------------------------ERROR OCCURS HERE "PERMISSION DENIED"
'Note that the line above runs perfectly if I do not programmatically open the folder in another method
Next folder
'Now we should have all the folders correctly named but they all have A that need removing
For Each folder In mySource.subFolders
folder.Name = Left(folder.Name, 21)
Next folder
Call ReAdjustNumbering
End If
Set oFSO = Nothing
Set mySource = Nothing
Set folder = Nothing
End SubHere is the code that stores or views files. If I don't run this code the above code works perfectly. If I "Open" any files, that's when the above code fails.
VBA Code:
Public Sub iDocDropOrOpen(sMode As String)
'We want to copy a file to our folder to msFilePath
Dim myFile As Variant
Dim sFileCopied As String
Dim oFSO As Object, Shex As Object
Dim vParts As Variant
Dim i As Long
Dim file As Variant, vFileSelected As Variant
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set myFile = Application.FileDialog(msoFileDialogOpen)
If sMode = "Drop" Then
With myFile
.Title = "Store file for this deliverable!"
.AllowMultiSelect = True
.InitialFileName = Environ("USERPROFILE") & "\"
If .Show <> -1 Then
Exit Sub
End If
For Each file In .SelectedItems
vFileSelected = file
vParts = Split(vFileSelected, "\")
sFileCopied = msFilePath & "\" & vParts(UBound(vParts))
Call oFSO.CopyFile(vFileSelected, sFileCopied, True)
Next file
End With
MsgBox "Your file has been successfully stored!", vbInformation
ElseIf sMode = "Open" Then
With myFile
.Title = "Choose File"
.AllowMultiSelect = True
.InitialFileName = msFilePath & "\"
If .Show <> -1 Then
Exit Sub
End If
For Each file In .SelectedItems
vFileSelected = file
Set Shex = CreateObject("Shell.Application")
Shex.Open vFileSelected
Next file
End With
End If
'Clean up
Set oFSO = Nothing
Set myFile = Nothing
Set Shex = Nothing
Set file = Nothing
Set vFileSelected = Nothing
End Sub
