I added a close file line in the "kill" and commented out another
Try this:
Option Explicit
Dim oFSO As Object, oFolder As Object, oFile As Object
Dim m_strRoot As String
Dim m_arrSubFolders() As String
Sub CreateFolderStructure()
'1. This procedure creates a folder structure on my C drive.
Dim lngIndex As Long
m_arrSubFolders = Split("Case Data|Case Data\Client|Case Data\Counsels|" _
& "Case Data\Misc|Case Templates|Files|Files\Faxes|Files\Letters|Files\Letters\PDF Final|Files\Letters\Client|" _
& "Files\Letters\Client\Drafts|Files\Letters\Opposing Counsel|Files\Letters\Other|Files\Memos|Files\Memos\PDF Final|" _
& "Files\Misc|Files\Pleadings|Files\Pleadings\Draft|Files\Pleadings\PDF", "|")
m_strRoot = "C:\Demo Issue"
CreateFolder m_strRoot
For lngIndex = 0 To UBound(m_arrSubFolders)
CreateFolder m_strRoot & "\" & m_arrSubFolders(lngIndex)
Next lngIndex
End Sub
Sub KillFoldersAndFiles()
'2. This procedure is intended to delete are files and folders in the folder structure created in step 1. _
It works fine if excuted immediately after the folder structure is created (all folders empty with no files).
Dim lngIndex As Long
m_arrSubFolders = Split("Case Data|Case Data\Client|Case Data\Counsels|" _
& "Case Data\Misc|Case Templates|Files|Files\Faxes|Files\Letters|Files\Letters\PDF Final|Files\Letters\Client|" _
& "Files\Letters\Client\Drafts|Files\Letters\Opposing Counsel|Files\Letters\Other|Files\Memos|Files\Memos\PDF Final|" _
& "Files\Misc|Files\Pleadings|Files\Pleadings\Draft|Files\Pleadings\PDF", "|")
Set oFSO = CreateObject("Scripting.FileSystemObject")
For lngIndex = UBound(m_arrSubFolders) To 0 Step -1
If fcnDirExists("C:\Demo Issue\" & m_arrSubFolders(lngIndex)) Then
Set oFolder = oFSO.GetFolder("C:\Demo Issue\" & m_arrSubFolders(lngIndex))
If oFolder = msoOpenFile Then Close ''''''''''''''''''''I added this line
For Each oFile In oFolder.Files
oFile.Delete
DoEvents
Next oFile
DoEvents
oFSO.DeleteFolder "C:\Demo Issue\" & m_arrSubFolders(lngIndex)
End If
Next lngIndex
DoEvents
'oFSO.DeleteFolder "C:\Demo Issue" ''''''''''''''I commented out this line
lbl_Exit:
Exit Sub
End Sub
Sub DemoIssue()
'3. However, if I create and save a file in one of the sub-folders created in step one and then run KillFoldersAndFiles, _
I get a Path/File Access error.
Dim oDoc As Document
m_strRoot = "C:\Demo Issue"
Set oDoc = Documents.Add
If Application.Version > 12# Then
oDoc.SaveAs2 FileName:=m_strRoot & "\Files\Pleadings\PDF\Demo Document", FileFormat:=wdFormatXMLDocumentMacroEnabled
Else
oDoc.SaveAs FileName:=m_strRoot & "\Files\Pleadings\PDF\Demo Document", FileFormat:=wdFormatXMLDocumentMacroEnabled
End If
oDoc.Close
' Set oDoc = Documents.Add
' If Application.Version > 12# Then
' oDoc.SaveAs2 Filename:=m_strRoot & "\Files\Letters\Demo Document", FileFormat:=wdFormatXMLDocumentMacroEnabled
' Else
' oDoc.SaveAs Filename:=m_strRoot & "\Files\Letters\Demo Document", FileFormat:=wdFormatXMLDocumentMacroEnabled
' End If
' oDoc.Close
lbl_Exit:
Set oDoc = Nothing
Exit Sub
End Sub
Sub DirectAttempt()
'After the error occurs, no attempt to delete the offending empty folder will work.
RmDir "C:\Demo Issue\Files\Pleadings\PDF"
End Sub
'Supporting functions
Private Function CreateFolder(ByRef strPath As String)
Dim lngIndex As Long
Dim vPath As Variant
vPath = Split(strPath, "\")
strPath = vPath(0) & "\"
For lngIndex = 1 To UBound(vPath)
strPath = strPath & vPath(lngIndex) & "\"
If Not fcnDirExists(strPath) Then MkDir strPath
Next lngIndex
lbl_Exit:
Exit Function
End Function
Function fcnDirExists(PathName As String) As Boolean
Dim lngTemp As Integer
On Error Resume Next
lngTemp = GetAttr(PathName)
Select Case Err.Number
Case Is = 0: fcnDirExists = True
Case Else: fcnDirExists = False
End Select
'Resume error checking
On Error GoTo 0
lbl_Exit:
Exit Function
End Function