How can I use Excel VBA to move files and do this by referencing a column in an Excel spreadsheet?

I need to move over 1000 files in various subfolders of root folder at C:\FolderA, to another folder, C:\FolderB. I have the names of the files that I need to move in column B of a sheet. I need the macro to loop through the subfolders of Folder A and refer to the file names in column B. If it finds a match, write, "On hand" in column C and move the file into Folder B. If it doesn't find a match, write, "Does not exist" in column C and do nothing. I drafted my idea of what the code might look like, but I'm getting a "Next without For" error.

Sub MoveFilesHybrid()

Dim objFSO As Object 'FileSystemObject
Dim objFile As Object 'File
Dim objFolder As Object 'Folder

bContinue = True
iRow = 2

Const strFolder As String = "U:\TestFrom"
Const strNewFolder As String = "U:\TestTo"

Set objFSO = CreateObject("Scripting.FileSystemObject")

For Each objFolder In objFSO.GetFolder(strFolder & "\").SubFolders
   While bContinue
    'If Right(objFolder.Name, 5) = "Test" Then
    For Each objFile In objFolder.Files
        If Len(Range("B" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK
        MsgBox "Process executed" ' DONE.
        bContinue = False
        Else
        'CHECK IF FILES EXIST.
        If Len(Range(strFolder & "B" & CStr(iRow)).Value) = o Then
        Range("C" & CStr(iRow)).Value = "Does not exist"
        Range("C" & CStr(iRow)).Font.Bold = True
        Else
        Range("C" & CStr(iRow)).Value = "On hand"
        Range("C" & CStr(iRow)).Font.Bold = False
        ''If InStr(1, objFile.Name, "dir", vbTextCompare) Then
                On Error Resume Next
                Kill strNewFolder & "\" & objFile.Name
                Err.Clear: On Error GoTo 0
                Name objFile.Path As strNewFolder & "\" & objFile.Name
        End If
        Next objFile
    'End If
Next objFolder

       iRow = iRow + 1      ' INCREMENT ROW COUNTER.
End Sub
calyx_terenAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
quick try...

Sub MoveFilesHybrid()

Dim objFSO As Object 'FileSystemObject
Dim objFile As Object 'File
Dim objFolder As Object 'Folder

bContinue = True
iRow = 2

Const strFolder As String = "U:\TestFrom"
Const strNewFolder As String = "U:\TestTo"

Set objFSO = CreateObject("Scripting.FileSystemObject")

For Each objFolder In objFSO.GetFolder(strFolder & "\").SubFolders
   do While bContinue
    'If Right(objFolder.Name, 5) = "Test" Then
    For Each objFile In objFolder.Files
        If Len(Range("B" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK
        MsgBox "Process executed" ' DONE.
        bContinue = False
        Else
        'CHECK IF FILES EXIST.
        If Len(Range(strFolder & "B" & CStr(iRow)).Value) = o Then
        Range("C" & CStr(iRow)).Value = "Does not exist"
        Range("C" & CStr(iRow)).Font.Bold = True
        Else
        Range("C" & CStr(iRow)).Value = "On hand"
        Range("C" & CStr(iRow)).Font.Bold = False
        ''If InStr(1, objFile.Name, "dir", vbTextCompare) Then
                On Error Resume Next
                Kill strNewFolder & "\" & objFile.Name
                Err.Clear: On Error GoTo 0
                Name objFile.Path As strNewFolder & "\" & objFile.Name
        End If
        Next
    'End If
    Loop
Next

       iRow = iRow + 1      ' INCREMENT ROW COUNTER.
End Sub

Open in new window

calyx_terenAuthor Commented:
I still get the "Next without For" error.
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
you missing out the "End If", try this instead.

Sub MoveFilesHybrid()

    Dim objFSO As Object 'FileSystemObject
    Dim objFile As Object 'File
    Dim objFolder As Object 'Folder
    
    bContinue = True
    iRow = 2
    
    Const strFolder As String = "U:\TestFrom"
    Const strNewFolder As String = "U:\TestTo"
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    For Each objFolder In objFSO.GetFolder(strFolder & "\").SubFolders
        Do While bContinue
            'If Right(objFolder.Name, 5) = "Test" Then
            For Each objFile In objFolder.Files
                If Len(Range("B" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK
                    MsgBox "Process executed" ' DONE.
                    bContinue = False
                Else
                    'CHECK IF FILES EXIST.
                    If Len(Range(strFolder & "B" & CStr(iRow)).Value) = o Then
                        Range("C" & CStr(iRow)).Value = "Does not exist"
                        Range("C" & CStr(iRow)).Font.Bold = True
                    Else
                        Range("C" & CStr(iRow)).Value = "On hand"
                        Range("C" & CStr(iRow)).Font.Bold = False
                    End If
                    ''If InStr(1, objFile.Name, "dir", vbTextCompare) Then
                    On Error Resume Next
                    Kill strNewFolder & "\" & objFile.Name
                    Err.Clear: On Error GoTo 0
                    Name objFile.Path As strNewFolder & "\" & objFile.Name
                End If
            Next
            'End If
        Loop
    Next
    
    iRow = iRow + 1      ' INCREMENT ROW COUNTER.
End Sub

Open in new window

Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

calyx_terenAuthor Commented:
Thanks, Ryan. That fixed the "Next without For" error, but I was getting a Run-time error '1004': Method "'Range of object' _Global" failed on this line.
If Len(Range(strFolder & "B" & CStr(iRow)).Value) = o Then

So I changed it to:
If Len(Dir(strFolder & Range("B" & CStr(iRow)).Value)) = o Then

That looks like it fixed error 1004, but now there are two other issues. 1. It looks like it entered an infinite loop and 2. It moves the entire contents of a folder instead of just the files whose names appears in column B. I attached a spreadsheet for reference.
Test-File-Move-Macro0.xlsm
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
what you trying to do with the cells value in your worksheet?

data
calyx_terenAuthor Commented:
I want the macro to use the File Name column as a lookup table. If the macro finds a File Name match with a file name in FolderA, then move that file to FolderB.
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
since you loop through the subfolders in the FolderA, if there is a file matched and is within the subfolder AA, how you want the file to be moved to FolderB? Just create a same folder structure in FolderB?
calyx_terenAuthor Commented:
The first part is right, but I don't need the same folder structure in FolderB. It is ok if the files are all at the same level in FolderB.
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
try this if you would like to have same folder structure after moving the files
Sub MoveFilesHybrid2()

    Dim objFSO As Object 'FileSystemObject
    Dim objFile As Object 'File
    Dim objFolder As Object 'Folder
    
    bContinue = True
    irow = 2
    
    Const strFolder As String = "U:\TestFrom\"
    Const strNewFolder As String = "U:\TestTo\"
        
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    Application.ScreenUpdating = False
    
    Do While Cells(irow, "B") <> ""
        For Each objFolder In objFSO.GetFolder(strFolder & "\").SubFolders
            For Each objFile In objFolder.Files
                Filename = Cells(irow, "B")
                If InStr(1, objFile.Name, Filename, vbTextCompare) > 0 Then
                    Cells(irow, "C") = "On hand"
                    Cells(irow, "C").Font.Bold = False
                    If Dir(strNewFolder & objFolder.Name & "\") = "" Then
                        MkDir strNewFolder & objFolder.Name & "\"
                    End If
                    If Dir(strNewFolder & objFolder.Name & "\" & objFile.Name) <> "" Then
                        Kill strNewFolder & objFolder.Name & "\" & objFile.Name
                    End If
                    objFSO.MoveFile objFile.Path, strNewFolder & objFolder.Name & "\" & objFile.Name
                Else
                    Cells(irow, "C") = "Does not exist"
                    Cells(irow, "C").Font.Bold = True
                End If
            Next
        Next
        
        irow = irow + 1 ' INCREMENT ROW COUNTER.
    Loop
    Application.ScreenUpdating = True
    MsgBox "Process executed" ' DONE.
End Sub

Open in new window


try this if you would like to have the files moving over to folderB at root folder (Be careful and make sure the files to be moved are having unique file names else the files could be overwritten)
Sub MoveFilesHybrid2()

    Dim objFSO As Object 'FileSystemObject
    Dim objFile As Object 'File
    Dim objFolder As Object 'Folder
    
    bContinue = True
    irow = 2
    
    Const strFolder As String = "U:\TestFrom\"
    Const strNewFolder As String = "U:\TestTo\"
        
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    Application.ScreenUpdating = False
    
    Do While Cells(irow, "B") <> ""
        For Each objFolder In objFSO.GetFolder(strFolder & "\").SubFolders
            For Each objFile In objFolder.Files
                Filename = Cells(irow, "B")
                If InStr(1, objFile.Name, Filename, vbTextCompare) > 0 Then
                    Cells(irow, "C") = "On hand"
                    Cells(irow, "C").Font.Bold = False
                    If Dir(strNewFolder & objFile.Name) <> "" Then
                        Kill strNewFolder & objFile.Name
                    End If
                    objFSO.MoveFile objFile.Path, strNewFolder & objFile.Name
                Else
                    Cells(irow, "C") = "Does not exist"
                    Cells(irow, "C").Font.Bold = True
                End If
            Next
        Next
        
        irow = irow + 1 ' INCREMENT ROW COUNTER.
    Loop
    Application.ScreenUpdating = True
    MsgBox "Process executed" ' DONE.
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
calyx_terenAuthor Commented:
Brililant! Thank you.
calyx_terenAuthor Commented:
Hi Ryan,

I spoke too soon. The code works fine if the files are one level below the parent, but not further down. The files that need to be moved are several levels deep, and the number of levels varies by folder. For example, File1 might be in Subfolder4 but File2 can be in Subfolder6, and Subfolder1, Subfolder2, and Subfolder3 might not have any files, just folders.

Also, sometimes the Does not exist shows up even if the file has been successfully moved.
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
>>The code works fine if the files are one level below the parent, but not further down.
yes, the codes need to be amended accordingly as from the scripts it only look for one level subfolders, not doing this recursively.

>> sometimes the Does not exist shows up even if the file has been successfully moved.
can you explain this further?
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.