Kilroy,
It will work here as well (most of the time) provided before running the Kill, I don't copy and paste more documents into the folders. If I do that and run the kill, then I get the error. Close and reopen Word and it runs and works with no errors.
Here is a slightly modified version in case some adds more sub-folders after creation.
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 ReDim Preserve m_arrSubFolders(0) Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFolder = oFSO.GetFolder("C:\Demo Issue") RecursiveFolder oFolder For lngIndex = UBound(m_arrSubFolders) - 1 To 0 Step -1 If fcnDirExists(m_arrSubFolders(lngIndex)) Then Set oFolder = oFSO.GetFolder(m_arrSubFolders(lngIndex)) If oFolder = msoOpenFile Then Close For Each oFile In oFolder.Files oFile.Delete DoEvents Next oFile DoEvents oFSO.DeleteFolder m_arrSubFolders(lngIndex) End If Next lngIndex DoEvents If fcnDirExists("C:\Demo Issue") Then Set oFolder = oFSO.GetFolder("C:\Demo Issue") If oFolder = msoOpenFile Then Close oFSO.DeleteFolder "C:\Demo Issue" End If 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 Sub RecursiveFolder(RootFolder) Dim oSubFolder For Each oSubFolder In RootFolder.SubFolders m_arrSubFolders(UBound(m_arrSubFolders)) = oSubFolder.Path ReDim Preserve m_arrSubFolders(UBound(m_arrSubFolders) + 1) Set oFolder = oFSO.GetFolder(oSubFolder) If oFolder.SubFolders.Count = 0 Then On Error Resume Next For Each oFile In oFolder.Files Debug.Print oFile.Path Next End If RecursiveFolder oSubFolder Next lbl_Exit: Exit Sub End Sub





Reply With Quote