Copy files to specific folders from list in Excel

johnbrownbaby

New Member
Joined
Dec 9, 2015
Messages
38
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:

2022-04-08_18-24-22.png



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


2022-05-21_17-53-42.png



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

VBA Code:
    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!
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
You're showing 6 .wav files and 8 folders.
Does each file need to be copied into each of the 8 folders?
 
Upvote 0
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!
 
Upvote 0
Here are two examples that you can work with :

VBA Code:
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
 

Attachments

  • Copy.jpg
    Copy.jpg
    103.3 KB · Views: 131
Upvote 0
Or like so maybe.
Code:
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
 
Upvote 0
Solution

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top