Copy files to specific folders from list in Excel

[johnbrownbaby]

I would like to copy specific files to specific folders using Excel VBA.

I obtained code that can allow the user to select the files and copy them to another folder as defined by the `msoFileDialogFolderPicker`. How to modify the code such that the respective file goes to the folder as defined in the excel sheet:

The folders already exist and are contained in the same main folder as the files. Here is the folder structure:

Here is the code for copying selected files to a folder:

    Sub movefiles()
    'Updateby Extendoffice
        Dim xRg As Range, xCell As Range
        Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
        Dim xSPathStr As Variant, xDPathStr As Variant
        Dim xVal As String
        On Error Resume Next
        Set xRg = Application.InputBox("Please select the file names:", "BooBooMan", ActiveWindow.RangeSelection.Address, , , , , 8)
        If xRg Is Nothing Then Exit Sub
        Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
        xSFileDlg.Title = " Please select the original folder:"
        If xSFileDlg.Show <> -1 Then Exit Sub
        xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
        'Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
        'xDFileDlg.Title = " Please select the destination folder:"
        'If xDFileDlg.Show <> -1 Then Exit Sub
        'xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
        For Each xCell In xRg
            xVal = xCell.Value
            If TypeName(xVal) = "String" And xVal <> "" Then
                FileCopy xSPathStr & xVal, xDPathStr & xVal
                Kill xSPathStr & xVal
            End If
        Next
    End Sub

How do I modify the code to copy the selected files to the respective folders as given in the excel columns? I would like to know how to get the xDPathStr by indexing the column number from the code above?

Please note that I have also posted this question on the stackexchange website but I have not gotten a favorable response.


Any Help will be greatly appreciated!

 

[jolivanes]

You're showing 6 .wav files and 8 folders.
Does each file need to be copied into each of the 8 folders?

 

[johnbrownbaby]

You're showing 6 .wav files and 8 folders.
Does each file need to be copied into each of the 8 folders?

Firstly, I enjoyed your quote. I love it!

The 2nd image is just for illustration as to the folder structure. I would like to copy the files selected in the excel file list to the corresponding folder found in the adjacent column. For example, from the first image, the file 145206-6-5-0.wav should be copied to fold8, and file 102305-6-0-0.wav should be copied to fold1.

From the 2nd image showing the folder structure, the files to be copied are in the same main folder as to where the folders are, in which the copied files need to go to.

Please let me know if this clears up your questions.

Thanks again for your help!

 

[Logit]

Here are two examples that you can work with :

Sub Copy_Files()
Dim cell As Range


For Each cell In Range("A2", Range("A" & Rows.Count).End(xlUp))

File = Dir(cell.Value)
If Len(File) > 0 Then
FileCopy Source:=cell.Value, Destination:=cell.Offset(, 1).Value
Else
cell.Offset(, 2).Value = "Fail"
End If
Next cell


Range("A1").Select

End Sub


Sub test()
Set rg = Range("A2", Range("A" & Rows.Count).End(xlUp))
For Each cell In rg
fn = cell.Value
src = cell.Offset(0, 1).Value + fn
dst = cell.Offset(0, 1).Value + "\" + fn
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Call fso.CopyFile(src, dst) 'to copy the file - original file in the source folder still there
'Call fso.MoveFile(src, dst) 'to move the file - original file in the source folder gone
Next
End Sub

 

[jolivanes]

Or like so maybe.

Sub Move_To_New_Folder()
Dim strPath As String
Dim i As Long
    strPath = "G:\Test\Work\DataSet\Mono"
        For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
            If Len(Cells(i, 1)) > 0 And Len(Cells(i, 1).Offset(, 1)) > 0 Then
                Name strPath & "\" & Cells(i, 1).Value As strPath & "\" & Cells(i, 1).Offset(, 1).Value & "\" & Cells(i, 1).Value
            End If
        Next i
End Sub