Dir not finishing loop through all files in a folder

[gusbus]

Hi all,

I made a Do While Loop with the Dir function. The issue is that it will not finishing looping through the entire source folder.

Thanks in advance!

Sub MyMoveFilesCreateFoldersP2()


    Dim myDestDir As String
    Dim myFileExt As String
    Dim i As Long
    Dim myFilePrefix As String
    Dim myFile As String
    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 DelFile As Boolean

'Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

'   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 As String
    mySourceDir = "C:\Users\kgustafson\Documents\FilesToBeMoved\"
    
'   Set source directory where subfolders are found
    myDestDir = "C:\Users\kgustafson\Documents\EntityFilings\"
    
'   Designate file extensions to move
    myFileExt = "*.*"
    
'   Designate worksheets 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 each Excel file in each directory
        myFile = Dir(mySourceDir & myFileExt)
        Do While Len(myFile) > 0
'           Get file prefix
            myFilePrefix = Left(myFile, 4)
'           Build source and destination references
            mySrc = mySourceDir & myFile
'           Indentify entity name
            myEntity = Application.WorksheetFunction.xlookup(myFilePrefix, wsSheet2.Range("A:A"), wsSheet2.Columns("C:C"), , 0, 1)
'           Specify the sub folder which is data validated on the worksheet
            mySubDest = wsSheet1.Range("B4").Value
'           Check if Entity Folder exists or not
            If Dir(myDestDir & myEntity, vbDirectory) = "" Then
                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 myDestDir & myEntity
                    MkDir myDestDir & myEntity & "\" & mySubDest
                    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 If
'           Check if Sub Folder exists or not
            If Dir(myDestDir & myEntity & "\" & mySubDest, vbDirectory) = "" Then
                MkDir myDestDir & myEntity & "\" & mySubDest
                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 Resume Next
            On Error GoTo 0
'           Delete source file, if flag is true
            If DelFile = True Then Kill mySrc
'           Reinitialize myFile
            myFile = Dir
        Loop
    
    
    MsgBox "Moves complete!"
    
    Exit Sub

End Sub

 

[RoryA]

You should never nest Dir calls within each other. I'd suggest you change one of them to something like the Scripting.FileSystemObject instead, or use one initial loop through all the files storing the reults in an array, and then a second loop that goes through each item in the array.

 

[gusbus]

You are right RoryA. I remade the entire macro with filesystemobject and that solved all my issues (took me awhile).

Thanks for your help!