Move selected files to selected folder based on excel list

sprs248

New Member
Joined
Aug 20, 2019
Messages
17
Hi,
I want to move left blue colored files to rightly mentioned red colored folder in all below cases.

File name





Folder name
C:\Users\LENOVO\Desktop\New folderC:\Users\LENOVO\Desktop\New folder\CSC21251
CSC212512016120120161231.emd CSC21251
CSC212512017010120170131.emdCSC21251
CSC212512017020120170228.emdCSC21251
CSC213032016120120161231.emdCSC21303
CSC213032017010120170131.emdCSC21303
CSC213032017020120170228.emdCSC21303
CSC217242016050120160531.emdCSC21724
CSC219082016090120160930.emdCSC21908
CSC219082016100120161031.emdCSC21908
CSC219082016110120161130.emdCSC21908

<colgroup><col><col></colgroup><tbody>
</tbody>

THANKS...
 

GirishDhruva

Active Member
Joined
Mar 26, 2019
Messages
265
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

Code:
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
 
Last edited:

sprs248

New Member
Joined
Aug 20, 2019
Messages
17
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

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

sprs248

New Member
Joined
Aug 20, 2019
Messages
17
Yes worked it... But I want to do this process in all rows data, mentioned at first Comment.




File name




Folder name
C:\Users\LENOVO\Desktop\New folderC:\Users\LENOVO\Desktop\New folder\CSC21251
CSC212512016120120161231.emdCSC21251
CSC212512017010120170131.emdCSC21251
CSC212512017020120170228.emdCSC21251
CSC213032016120120161231.emdCSC21303
CSC213032017010120170131.emdCSC21303
CSC213032017020120170228.emdCSC21303
CSC217242016050120160531.emdCSC21724
CSC219082016090120160930.emdCSC21908
CSC219082016100120161031.emdCSC21908
CSC219082016110120161130.emdCSC21908

<tbody>
</tbody>
I have large volume of files for moving...
 

GirishDhruva

Active Member
Joined
Mar 26, 2019
Messages
265
Hi @sprs248,

Try with the below code

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
 

Forum statistics

Threads
1,085,834
Messages
5,386,224
Members
401,986
Latest member
crt54

Some videos you may like

This Week's Hot Topics

Top