asked on

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

Ryan Chong

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 Teren

ASKER

I still get the "Next without For" error.

Ryan Chong

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

Calyx Teren

ASKER

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 Chong

what you trying to do with the cells value in your worksheet?

Calyx Teren

ASKER

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 Chong

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 Teren

ASKER

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.

ASKER CERTIFIED SOLUTION

Ryan Chong

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Calyx Teren

ASKER

Brililant! Thank you.

Calyx Teren

ASKER

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 Chong

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