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?
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 ChongCommented:
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

0
calyx_terenAuthor Commented:
I still get the "Next without For" error.
0
Ryan ChongCommented:
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

0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

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
0
Ryan ChongCommented:
what you trying to do with the cells value in your worksheet?

data
0
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.
0
Ryan ChongCommented:
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?
0
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.
0
Ryan ChongCommented:
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

0

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.
0
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.
0
Ryan ChongCommented:
>>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?
0
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.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.