Move selected files to selected folder based on excel list

[sprs248]

[TABLE="width: 578"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]Hi,
I want to move left blue colored files to rightly mentioned red colored folder in all below cases.

File name[/TD]
[TD]




Folder name[/TD]
[/TR]
[TR]
[TD]C:\Users\LENOVO\Desktop\New folder[/TD]
[TD]C:\Users\LENOVO\Desktop\New folder\CSC21251[/TD]
[/TR]
[TR]
[TD]CSC212512016120120161231.emd [/TD]
[TD]CSC21251[/TD]
[/TR]
[TR]
[TD]CSC212512017010120170131.emd[/TD]
[TD]CSC21251[/TD]
[/TR]
[TR]
[TD]CSC212512017020120170228.emd[/TD]
[TD]CSC21251[/TD]
[/TR]
[TR]
[TD]CSC213032016120120161231.emd[/TD]
[TD]CSC21303[/TD]
[/TR]
[TR]
[TD]CSC213032017010120170131.emd[/TD]
[TD]CSC21303[/TD]
[/TR]
[TR]
[TD]CSC213032017020120170228.emd[/TD]
[TD]CSC21303[/TD]
[/TR]
[TR]
[TD]CSC217242016050120160531.emd[/TD]
[TD]CSC21724[/TD]
[/TR]
[TR]
[TD]CSC219082016090120160930.emd[/TD]
[TD]CSC21908[/TD]
[/TR]
[TR]
[TD]CSC219082016100120161031.emd[/TD]
[TD]CSC21908[/TD]
[/TR]
[TR]
[TD]CSC219082016110120161130.emd[/TD]
[TD]CSC21908[/TD]
[/TR]
</tbody>[/TABLE]

THANKS...

 

[GirishDhruva]

Hi i am not expert in Coding but Try with the below code

Conditions:
Cell "A2" should contain Source Path and Cell "B2" should contain Destination Path and Column C should contain File Names
and by your question i understood that you need to copy only .emd files so only i have hard-coded that

Option Explicit


Sub MoveFiles()
    Dim FSO As Object
    Dim SourceFileName, SourceFileName1 As String, DestinFileName, DestinFileName1, Filename As String
    Dim lr, x As Long
    
    Set FSO = CreateObject("Scripting.Filesystemobject")
    SourceFileName1 = Range("A2").Value
    DestinFileName1 = Range("B2").Value
    lr = Cells(Rows.Count, "C").End(xlUp).Row
    
    For x = 2 To lr
        Filename = Range("C" & x).Value
        SourceFileName = SourceFileName1 & "\" & Filename & ".emd"
        DestinFileName = DestinFileName1 & "\" & Filename & ".emd"
        If Not FSO.FileExists(SourceFileName) Then
            MsgBox ("File Not Found in " & SourceFileName)
        Else
            FSO.MoveFile Source:=SourceFileName, Destination:=DestinFileName
            MsgBox (SourceFileName + " Moved to " + DestinFileName)
        End If
    Next x
    
End Sub

Regards
Dhruva

 

[sprs248]

Hi i am not expert in Coding but Try with the below code

Conditions:
Cell "A2" should contain Source Path and Cell "B2" should contain Destination Path and Column C should contain File Names
and by your question i understood that you need to copy only .emd files so only i have hard-coded that

Option Explicit


Sub MoveFiles()
    Dim FSO As Object
    Dim SourceFileName, SourceFileName1 As String, DestinFileName, DestinFileName1, Filename As String
    Dim lr, x As Long
    
    Set FSO = CreateObject("Scripting.Filesystemobject")
    SourceFileName1 = Range("A2").Value
    DestinFileName1 = Range("B2").Value
    lr = Cells(Rows.Count, "C").End(xlUp).Row
    
    For x = 2 To lr
        Filename = Range("C" & x).Value
        SourceFileName = SourceFileName1 & "\" & Filename & ".emd"
        DestinFileName = DestinFileName1 & "\" & Filename & ".emd"
        If Not FSO.FileExists(SourceFileName) Then
            MsgBox ("File Not Found in " & SourceFileName)
        Else
            FSO.MoveFile Source:=SourceFileName, Destination:=DestinFileName
            MsgBox (SourceFileName + " Moved to " + DestinFileName)
        End If
    Next x
    
End Sub

Regards
Dhruva

After Run, No response..

 

[GirishDhruva]

have you gone through my conditions, which i have mentioned above the code

 

[sprs248]

After Run, No response..

If anything to Edit or directly COPY & Paste abd Run the Code???

 

[sprs248]

have you gone through my conditions, which i have mentioned above the code

No ... Not understand, what to edit..

 

[GirishDhruva]

Open an Excel file add this data
https://www.dropbox.com/s/khdd4a1kxcy0fqi/Move_Files_V1.xlsm?dl=0

and add the above code and run

 

[sprs248]

Open an Excel file add this data
https://www.dropbox.com/s/khdd4a1kxcy0fqi/Move_Files_V1.xlsm?dl=0

and add the above code and run

Yes worked it... But I want to do this process in all rows data, mentioned at first Comment.

 

[sprs248]

Yes worked it... But I want to do this process in all rows data, mentioned at first Comment.

[TABLE="class: cms_table, width: 578"]
<tbody>[TR]
[TD]



File name[/TD]
[TD]



Folder name[/TD]
[/TR]
[TR]
[TD]C:\Users\LENOVO\Desktop\New folder[/TD]
[TD]C:\Users\LENOVO\Desktop\New folder\CSC21251[/TD]
[/TR]
[TR]
[TD]CSC212512016120120161231.emd[/TD]
[TD]CSC21251[/TD]
[/TR]
[TR]
[TD]CSC212512017010120170131.emd[/TD]
[TD]CSC21251[/TD]
[/TR]
[TR]
[TD]CSC212512017020120170228.emd[/TD]
[TD]CSC21251[/TD]
[/TR]
[TR]
[TD]CSC213032016120120161231.emd[/TD]
[TD]CSC21303[/TD]
[/TR]
[TR]
[TD]CSC213032017010120170131.emd[/TD]
[TD]CSC21303[/TD]
[/TR]
[TR]
[TD]CSC213032017020120170228.emd[/TD]
[TD]CSC21303[/TD]
[/TR]
[TR]
[TD]CSC217242016050120160531.emd[/TD]
[TD]CSC21724[/TD]
[/TR]
[TR]
[TD]CSC219082016090120160930.emd[/TD]
[TD]CSC21908[/TD]
[/TR]
[TR]
[TD]CSC219082016100120161031.emd[/TD]
[TD]CSC21908[/TD]
[/TR]
[TR]
[TD]CSC219082016110120161130.emd[/TD]
[TD]CSC21908[/TD]
[/TR]
</tbody>[/TABLE]
I have large volume of files for moving...

 

[GirishDhruva]

Hi @sprs248,

Try with the below code

Option Explicit


Sub MoveFiles()
    Dim FSO As Object
    Dim PATH, sourcefile As String, dest, DestinationFolderName, SourceFileName, Filename As String
    Dim lr, x As Long
    
    Set FSO = CreateObject("Scripting.Filesystemobject")
    PATH = Range("D2").Value
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
    If PATH <> "" Then
        For x = 2 To lr
            SourceFileName = Range("A" & x).Value
            DestinationFolderName = Range("B" & x).Value
            sourcefile = PATH & "\" & SourceFileName & ".emd"
            dest = PATH & "\" & DestinationFolderName & "\" & SourceFileName & ".emd"
            If Not FSO.FileExists(sourcefile) Then
                MsgBox ("File Not Found in " & sourcefile)
            Else
                FSO.MoveFile source:=sourcefile, Destination:=dest
                MsgBox (sourcefile + " Moved to " + dest)
            End If
        Next x
    Else
        MsgBox ("Please Insert PATH in cell 'D2'")
        Exit Sub
    End If
End Sub

Regards
Dhruva