Run-time error 5 with Dir

[gusbus]

Hi all,

I have issues dealing with two common scenarios with my folder creation and document filing macro. Three scenarios exist

1. Entity folder and sub folder exist - program files automatically
   1. This seems to be working fine as long as I do not run into any of these exceptions below
2. Sub folder does not exist (most common) - create folder and notify user that it was created, continue filing
   1. If this exception occurs, I get knocked out of my loop and the program ends after the sub folder is created and that file is added and deleted from the source
   2. I get a Run-time error 5 on the "myFile = Dir" portion of my code so the program does not make it through all the files
3. Entity folder does not exist (primary folder) - give the user the option to create the new primary folder or remove the file the filing source folder
   1. If this exception occurs, the new folder and sub folder are created but I get knocked out of the loop and file is not pulled in

Sub MyMoveFilesCreateFolders1()


    Dim myDestDir As String
    Dim myFileExt As String
    Dim i As Long
    Dim myFilePrefix As String
    Dim myFile
    Dim mySrc As String
    Dim wbBook1 As Workbook
    Dim wbBook2 As Workbook
    Dim wsSheet1 As Worksheet
    Dim wsSheet2 As Worksheet
    Dim myEntity As String
    Dim mySubDest As String
    Dim myDest As String
    Dim myFolderpath1 As String
    Dim myFolderpath2 As String
    Dim myFolderexists1 As String
    Dim myFolderexists2 As String
    Dim DelFile As Boolean

'   Set up an array for all the different directories you wish to copy files from
'   Number in parentheses of variable declaration should be number of items in array - 1
    Dim mySourceDir(1)
    mySourceDir(0) = "C:\Users\kgustafson\Documents\FilesToBeMoved0\"
    mySourceDir(1) = "C:\Users\kgustafson\Documents\FilesToBeMoved1\"
    
'   Set source directory where subfolders are found
    myDestDir = "C:\Users\kgustafson\Documents\EntityFilings\"
    
'   Designate file extensions to move
    myFileExt = "*.*"
    
'   Designate files for file references and location
    Set wbBook1 = ThisWorkbook
    Set wbBook2 = Workbooks.Open("C:\Users\kgustafson\Local_Temp\Caps.xlsx")
    
    Set wsSheet1 = wbBook1.Worksheets("File Moving")
    Set wsSheet2 = wbBook2.Worksheets("Caps")
    
    
'   ***********************************************************************************
    
'   Loop through all each directory
    For i = LBound(mySourceDir) To UBound(mySourceDir)
'       Loop through each Excel file in each directory
        myFile = Dir(mySourceDir(i) & myFileExt)
        Do While Len(myFile) > 0
'           Get file prefix
            myFilePrefix = Left(myFile, 4)
'           Build source and destination references
            mySrc = mySourceDir(i) & myFile
'           Indentify entity name
            myEntity = Application.WorksheetFunction.xlookup(myFilePrefix, wsSheet2.Range("A:A"), wsSheet2.Columns("C:C"), , 0, 1)
'           Specify the sub folder
            mySubDest = wsSheet1.Range("B4").Value
'           Create primary folderpath to check if it exists
            myFolderpath1 = myDestDir & myEntity
            myFolderpath2 = myFolderpath1 & "\" & mySubDest & "\"
            myFolderexists1 = Dir(myFolderpath1, vbDirectory)
            myFolderexists2 = Dir(myFolderpath2, vbDirectory)
'           Check if Entity Folder exists or not
            If myFolderexists1 = "" Then
                GoTo No_Folder_Entity1:
                End If
'           Check if Sub Folder exists or not
            If myFolderexists2 = "" Then
                MkDir myFolderpath2
                MsgBox "New " & mySubDest & " folder has been created for " & myEntity & ".", vbOKOnly, "Information"
                End If
'           Create entire folder destination
            myDest = myDestDir & myEntity & "\" & mySubDest & "\" & myFile
'           Set boolean value to delete file
            DelFile = True
'           Copy file from source to destination
            FileCopy mySrc, myDest
            On Error GoTo 0
'           Delete source file, if flag is true
            If DelFile = True Then Kill mySrc
'           Reinitialize myFile
            myFile = Dir
        Loop
    Next i
    
    MsgBox "Moves complete!"
    
    Exit Sub
    

No_Folder_Entity1:
'   If cannot find directory for file, do not delete, create entity folder, return message box, and continue
        DelFile = False
'       Have user decide to create entity folder or remove the file manually
        result = MsgBox(myEntity & " folder does not exist, do you want to create it?", vbYesNo, "Entity Folder Does Not Exist!!!")
        Select Case result
'       User chooses yes - create folder and subfolder
        Case vbYes
            MkDir myFolderpath1
            MkDir myFolderpath2
            MsgBox ("Entity folder and subfolder created, please re-run program to place file")
'       User chooses no - do not create folder and tell user to remove the file from folder
        Case vbNo
            MsgBox ("Entity folder not created, please remove" & myFile)
        End Select
        
    

End Sub

 

[Micron]

Yikes, that's an eyeful. I presume you're raising error 5 when attempting to use Dir, so trap it with an error handler that says

If err.Number = 5 Then ...

create the folder with code and

Resume

That assumes that the line that caused that error is where you want to go back to. If that was to be the next line after the one that raised the error, Resume Next.
Try to avoid using GoTo lines to handle problems. If you search recent threads of mine using keywords exitHere I suspect you'll find examples of error handlers and exit points. You should be setting object variables to Nothing before exiting (anything that you Set).

 

[gusbus]

Hi Micron,

I did a total rework last work last night and removed the GoTo statement and removed the multifolder loop which solved my runtime 5 issue. Now I have a new issue that it is not looping through all the files, it will do the action on one file and stop.

Thanks for your help, I will make a new post.

 

[Micron]

Does your loop part look something like this:

Dim strFileName As String

strFileName = Dir(yourPathHere)
Do While Len(strFileName) > 0
     Debug.Print strFileName
Loop