[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]

ehh...........tht possible...
if it happen, i think is best to avoid copy and set A File Error has Occurred? is the possible be able to do it?

Thanks mate~!

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?

 

[Fluff]

Give this a go

Sub CopyFile()

    Dim Cl As Range
    Dim SrcFle As String
    Dim DestFle As String
    Dim Fname As String
    Dim Cnt As Long
    
    
    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
            Cnt = 0
            Do While Len(SrcFle) > 0
                Cnt = Cnt + 1
                SrcFle = Dir
            Loop
            If Cnt = 1 Then
                SrcFle = Dir(Cl.Offset(, 1).Value & "\" & Fname & "*")
                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 = "More than 1 file found"             'File was not found in source folder
            End If
        Else
            Cl.Offset(, 3).Value = "Source file doesn't exist"
        End If
    Next Cl
    
End Sub

 

[harky]

omg.. i just tried it.. it work like charm!

i notice i had to put in only the first few number or letter before _ and left out the filename extension and it copied~~

ya tht is what i want!

thanks Fluff, you so kind to help

Give this a go

Sub CopyFile()

    Dim Cl As Range
    Dim SrcFle As String
    Dim DestFle As String
    Dim Fname As String
    Dim Cnt As Long
    
    
    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
            Cnt = 0
            Do While Len(SrcFle) > 0
                Cnt = Cnt + 1
                SrcFle = Dir
            Loop
            If Cnt = 1 Then
                SrcFle = Dir(Cl.Offset(, 1).Value & "\" & Fname & "*")
                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 = "More than 1 file found"             'File was not found in source folder
            End If
        Else
            Cl.Offset(, 3).Value = "Source file doesn't exist"
        End If
    Next Cl
    
End Sub

 

[Fluff]

Glad to help & thanks for the feedback

 

[harky]

Hi,

the previously script which is still usable for me. Is it possible to amend it to if File was not found in source folder, do no create folder?

Sub CopyFileWithNo[COLOR=#333333]Ext[/COLOR]()

    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

Glad to help & thanks for the feedback

 

[Fluff]

The code I supplied in post#19 & post#22 does that

 

[harky]

oh! just try. it work. Thanks!

The code I supplied in post#19 & post#22 does that

 

[Fluff]

Glad to help & thanks for the feedback

 

[harky]

Hi,
I need some help on this code..

The filecopy working well BUT i had one issue.

if there are file which look like this

859_1_4_58111.pdf <-- file copied
859A_1_4_58111.pdf <-- More than 1 file found

it will say more than 1 file found but both file are belong to diff filename.
as anything after _ will be ignore..

i put 859 & 859A as my filename

Glad to help & thanks for the feedback

 

[harky]

Sorry, make a mistake by tell u to put ignore if
But i tot 859A is a new name? :/


Possible just follow COL A filename

as anything after _ will be ignore

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?