Path/Access Error

[Kilroy]

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