[VB help needed] Copy mulit folder files to Destination based on excel

[harky]

	column A	column B	column C
Row 1	File Name	Source Path	Destination Path (Copy)
Row 2	70401.PDF	C:\Users\xxx\Desktop\MasterPath\Route 13	C:\Users\xxx\Desktop\Saved Folder\70401
Row 3	70401.PDF	C:\Users\xxx\Desktop\MasterPath\Route 16	C:\Users\xxx\Desktop\Saved Folder\70401
Row 4	70401.PDF	C:\Users\xxx\Desktop\MasterPath\Route 19	C:\Users\xxx\Desktop\Saved Folder\70401
Row 5	70409.PDF	C:\Users\xxx\Desktop\MasterPath\Route 16	C:\Users\xxx\Desktop\Saved Folder\70409
Row 6	70409.PDF	C:\Users\xxx\Desktop\MasterPath\Route 19	C:\Users\xxx\Desktop\Saved Folder\70409

<tbody>
</tbody>

Hi, i need some help as i had thousand of file to be move.
Is it possible to create marco and based on the excel list to COPY AND PASTE mulit folder files to Destination ?

For e.g i had 70401.PDF from Path C:\Users\xxx\Desktop\MasterPath\Route 13
COPY to C:\Users\xxx\Desktop\Saved Folder\70401

 

[harky]

omg thanks pro.
it work great (tested on excel 2016) and it will help me alot. i had thousand of files to copy and paste, this will save my time.
really appreciate it.

Try this

Sub CopyFile()

    Dim Cl As Range
    Dim SrcFle As String
    Dim DestFle As String
    Dim Fname As String
    
    
    For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If Dir(Cl.Offset(, 2).Value, vbDirectory) = "" Then MkDir Cl.Offset(, 2).Value
        Fname = Cl.Value
        SrcFle = ""
        DestFle = ""
        SrcFle = Dir(Cl.Offset(, 1).Value & "\" & Fname)
        DestFle = Dir(Cl.Offset(, 2).Value & "\" & Fname)
        If Len(SrcFle) > 0 And Len(DestFle) = 0 Then
            FileCopy Cl.Offset(, 1).Value & "\" & Fname, _
                Cl.Offset(, 2).Value & "\" & Fname
            Cl.Offset(, 3).Value = "Copied"                     'File was copied to new folder
        ElseIf Len(SrcFle) = 0 Then
            Cl.Offset(, 3).Value = "File not found"             'File was not found in source folder
        ElseIf Len(DestFle) > 0 Then
            Cl.Offset(, 3).Value = "File Exists"                'File already exists in destination folder
        End If
    Next Cl
    
End Sub

 

[Fluff]

Glad to help & thanks for the feedback

 

[harky]

Hi Fluff..

Really thank your help but i notice my file naming had some issue.

e.g
My filename is named as
130_2_8_xxxx.PDF
132_2_8_xxxx.PDF
32_2_8_xxxx.PDF
145_2_8_xxxx.PDF

Under column A (Filename), will it possible to to recognise the first 3 letter? anything after _ will be ignore?

Glad to help & thanks for the feedback

 

[harky]

maybe not first 3 letter but anything after _ will be ignore.

 

[Fluff]

Not quite sure what you mean

 

[harky]

ehh

My PDF filename is named (below) but there are thousand of filename which is allocated with a S/N foldername.

Folder name "1234" contain:
130_1_8_1234.PDF
132_2_8_1234.PDF
32_3_8_1234.PDF
145 _4_8_1234.PDF

Folder name "9999" contain:
130_5_8_9999.PDF
132_1_8_9999.PDF
32_3_8_9999.PDF
145_5_8_9999.PDF

For the above VB, is easy for me to set source folder but not the filename.
the one in red, is what i hope VB can recognize and anything after _ will be ignore when copy the file even i did not key in the full filename.

Not quite sure what you mean

 

[Fluff]

Rather than putting the whole file name into col A just put the start (ie 130, or 130_5_8) & try this

Sub CopyFile()

    Dim Cl As Range
    Dim SrcFle As String
    Dim DestFle As String
    Dim Fname As String
    
    
    For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If Dir(Cl.Offset(, 2).Value, vbDirectory) = "" Then MkDir Cl.Offset(, 2).Value
        Fname = Cl.Value
        SrcFle = ""
        DestFle = ""
        SrcFle = Dir(Cl.Offset(, 1).Value & "\" & Fname & "*")
        DestFle = Dir(Cl.Offset(, 2).Value & "\" & Fname & "*")
        If Len(SrcFle) > 0 And Len(DestFle) = 0 Then
            FileCopy Cl.Offset(, 1).Value & "\" & SrcFle, _
                Cl.Offset(, 2).Value & "\" & SrcFle
            Cl.Offset(, 3).Value = "Copied"                     'File was copied to new folder
        ElseIf Len(SrcFle) = 0 Then
            Cl.Offset(, 3).Value = "File not found"             'File was not found in source folder
        ElseIf Len(DestFle) > 0 Then
            Cl.Offset(, 3).Value = "File Exists"                'File already exists in destination folder
        End If
    Next Cl
    
End Sub

 

[harky]

not able to put the whole filename as our data base only recorded the one in red.

and if File was not found in source folder, is it possible not to create the folder?

Rather than putting the whole file name into col A just put the start (ie 130, or 130_5_8) & try this

Sub CopyFile()

    Dim Cl As Range
    Dim SrcFle As String
    Dim DestFle As String
    Dim Fname As String
    
    
    For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If Dir(Cl.Offset(, 2).Value, vbDirectory) = "" Then MkDir Cl.Offset(, 2).Value
        Fname = Cl.Value
        SrcFle = ""
        DestFle = ""
        SrcFle = Dir(Cl.Offset(, 1).Value & "\" & Fname & "*")
        DestFle = Dir(Cl.Offset(, 2).Value & "\" & Fname & "*")
        If Len(SrcFle) > 0 And Len(DestFle) = 0 Then
            FileCopy Cl.Offset(, 1).Value & "\" & SrcFle, _
                Cl.Offset(, 2).Value & "\" & SrcFle
            Cl.Offset(, 3).Value = "Copied"                     'File was copied to new folder
        ElseIf Len(SrcFle) = 0 Then
            Cl.Offset(, 3).Value = "File not found"             'File was not found in source folder
        ElseIf Len(DestFle) > 0 Then
            Cl.Offset(, 3).Value = "File Exists"                'File already exists in destination folder
        End If
    Next Cl
    
End Sub

 

[Fluff]

Try

Sub CopyFile()

    Dim Cl As Range
    Dim SrcFle As String
    Dim DestFle As String
    Dim Fname As String
    
    
    For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
        Fname = Cl.Value
        SrcFle = ""
        DestFle = ""
        SrcFle = Dir(Cl.Offset(, 1).Value & "\" & Fname & "*")
        If Len(SrcFle) > 0 Then
            If Dir(Cl.Offset(, 2).Value, vbDirectory) = "" Then MkDir Cl.Offset(, 2).Value
            DestFle = Dir(Cl.Offset(, 2).Value & "\" & Fname & "*")
            If Len(DestFle) = 0 Then
                FileCopy Cl.Offset(, 1).Value & "\" & SrcFle, _
                    Cl.Offset(, 2).Value & "\" & SrcFle
                Cl.Offset(, 3).Value = "Copied"                     'File was copied to new folder
            ElseIf Len(DestFle) > 0 Then
                Cl.Offset(, 3).Value = "File Exists"                'File already exists in destination folder
            End If
        Else
            Cl.Offset(, 3).Value = "File not found"             'File was not found in source folder
        End If
    Next Cl
    
End Sub

 

[Fluff]

If you have, say 130, in Col A are you likely to have more than 1 file in the source folder that begins with 130?