Shammas

New Member
Joined
Apr 7, 2019
Messages
5
Hi friends,

I'm using excel VBA for copying list of files from column, I prepared program to copy files to a specific destination (Below the program)
I need help to create program for copying files to a list of destination listed in column respective to list of files

Option Explicit
Sub CopyFiles()
Dim FSO
Dim iRow As Integer ' ROW COUNTER.
Dim sSFolder As String
Dim sDFolder As String
Dim sFileType As String

Dim bContinue As Boolean

bContinue = True
iRow = 2

' THE SOURCE AND DESTINATION FOLDER WITH PATH.
sSFolder = Sheets("Book1").Range("D5")
sDFolder = Sheets("Book1").Range("D6")

Set FSO = CreateObject("Scripting.FileSystemObject")

sFileType = ".pdf" ' TRY WITH OTHER FILE TYPES LIKE ".pdf".

' LOOP THROUGH COLUMN "B" TO PICK THE FILES.
While bContinue

If Len(Range("B" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK.
MsgBox "Process executed" ' DONE.
bContinue = False
Else
' CHECK IF FILES EXISTS.

If Len(Dir(sSFolder & Range("B" & CStr(iRow)).Value & sFileType)) = 0 Then
Range("C" & CStr(iRow)).Value = "Does Not Exists"
Range("C" & CStr(iRow)).Font.Bold = True
Else
Range("C" & CStr(iRow)).Value = "On Hand"
Range("C" & CStr(iRow)).Font.Bold = False

If Trim(sDFolder) <> "" Then
Dim objFSO
Set objFSO = CreateObject("scripting.filesystemobject")

' CHECK IF DESTINATION FOLDER EXISTS.
If objFSO.FolderExists(sDFolder) = False Then
MsgBox sDFolder & " Does Not Exists"
Exit Sub
End If

'*****
' HERE I HAVE INCLUDED TWO DIFFERENT METHODS.
' I HAVE COMMENTED THE SECOND METHOD. TO THE SEE THE RESULT OF THE
' SECOND METHOD, UNCOMMENT IT AND COMMENT THE FIRST METHOD.

' METHOD 1) - USING "CopyFile" METHOD TO COPY THE FILES.
objFSO.CopyFile Source:=sSFolder & Range("B" & CStr(iRow)).Value & _
sFileType, Destination:=sDFolder

' METHOD 2) - USING "MoveFile" METHOD TO PERMANENTLY MOVE THE FILES.
'objFSO.MoveFile Source:=sSFolder & Range("B" & CStr(iRow)).Value & _
sFileType, Destination:=sDestinationPath
'*****
End If
End If
End If

iRow = iRow + 1 ' INCREMENT ROW COUNTER.
Wend
End Sub
 

Some videos you may like

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
Try this. Change red "D" for the column with the destination folder

Code:
Option Explicit
Sub CopyFiles()
    Dim FSO
    Dim iRow As Integer ' ROW COUNTER.
    Dim sSFolder As String
    Dim sDFolder As String
    Dim sFileType As String
    
    Dim bContinue As Boolean
    
    bContinue = True
    iRow = 2
    
    ' THE SOURCE AND DESTINATION FOLDER WITH PATH.
    sSFolder = Sheets("Book1").Range("D5")
    sDFolder = Sheets("Book1").Range("D6")
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    sFileType = ".pdf" ' TRY WITH OTHER FILE TYPES LIKE ".pdf".
    
    ' LOOP THROUGH COLUMN "B" TO PICK THE FILES.
    While bContinue
    
        If Len(Range("B" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK.
            MsgBox "Process executed" ' DONE.
            bContinue = False
        Else
            ' CHECK IF FILES EXISTS.
            
            If Len(Dir(sSFolder & Range("B" & CStr(iRow)).Value & sFileType)) = 0 Then
                Range("C" & CStr(iRow)).Value = "Does Not Exists"
                Range("C" & CStr(iRow)).Font.Bold = True
            Else
                Range("C" & CStr(iRow)).Value = "On Hand"
                Range("C" & CStr(iRow)).Font.Bold = False
                
[COLOR=#0000cd]                sDFolder = Range("[/COLOR][B][COLOR=#ff0000]D[/COLOR][/B][COLOR=#0000cd]" & CStr(iRow)).Value[/COLOR]
                
                If Trim(sDFolder) <> "" Then
                    Dim objFSO
                    Set objFSO = CreateObject("scripting.filesystemobject")
                    
                    ' CHECK IF DESTINATION FOLDER EXISTS.
                    If objFSO.FolderExists(sDFolder) = False Then
                        MsgBox sDFolder & " Does Not Exists"
                        Exit Sub
                    End If
                    
                    '*****
                    ' HERE I HAVE INCLUDED TWO DIFFERENT METHODS.
                    ' I HAVE COMMENTED THE SECOND METHOD. TO THE SEE THE RESULT OF THE
                    ' SECOND METHOD, UNCOMMENT IT AND COMMENT THE FIRST METHOD.
                    
                    ' METHOD 1) - USING "CopyFile" METHOD TO COPY THE FILES.
                    objFSO.CopyFile Source:=sSFolder & Range("B" & CStr(iRow)).Value & _
                    sFileType, Destination:=sDFolder
                    
                    ' METHOD 2) - USING "MoveFile" METHOD TO PERMANENTLY MOVE THE FILES.
                    'objFSO.MoveFile Source:=sSFolder & Range("B" & CStr(iRow)).Value & _
                    sFileType, Destination:=sDestinationPath
                    '*****
                End If
            End If
        End If
        
        iRow = iRow + 1 ' INCREMENT ROW COUNTER.
    Wend
End Sub
 

Shammas

New Member
Joined
Apr 7, 2019
Messages
5
Thanks you for your replay,

But still the files are copying to the previous 1 destination, below is the structure of my excel file

Files name to copy Status Folders to copy
LRT-QAG-028898On HandC:\Users\smoopil\Desktop\excel\Test\BLC03\ACV\
LRT-QAG-029972On HandC:\Users\smoopil\Desktop\excel\Test\BLC03\PDS\
LRT-QAG-029975On HandC:\Users\smoopil\Desktop\excel\Test\BLC03\FSS\
LRT-QAG-029978On HandC:\Users\smoopil\Desktop\excel\Test\EC201\ACV\
LRT-QAG-029979On HandC:\Users\smoopil\Desktop\excel\Test\EC201\ACV\
LRT-QAG-029980On HandC:\Users\smoopil\Desktop\excel\Test\EC201\FSS\
LRT-QAG-029981On HandC:\Users\smoopil\Desktop\excel\Test\EDD01\ACV\
LRT-QAG-029982On HandC:\Users\smoopil\Desktop\excel\Test\EDD01\PDS\


Please help me

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

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
Are you using the method below?

Code:
' METHOD 1) - USING "CopyFile" METHOD TO COPY THE FILES.
                    objFSO.CopyFile Source:=sSFolder & Range("B" & CStr(iRow)).Value & _
                    sFileType, Destination:=sDFolder

Did you add the line of code?

Code:
[COLOR=#0000cd]sDFolder = Range("[/COLOR][B][COLOR=#ff0000]D[/COLOR][/B][COLOR=#0000cd]" & CStr(iRow)).Value[/COLOR]

How did you add it?
 

Shammas

New Member
Joined
Apr 7, 2019
Messages
5

ADVERTISEMENT

I copied the same program in your first replay, and also I tried replacing my sDfolder line with the above, but still not working, below the updated program program

Option Explicit
Sub CopyFiles()
Dim FSO
Dim iRow As Integer ' ROW COUNTER.
Dim sSFolder As String
Dim sDFolder As String
Dim sFileType As String

Dim bContinue As Boolean

bContinue = True
iRow = 2

' THE SOURCE AND DESTINATION FOLDER WITH PATH.
sSFolder = Sheets("Book1").Range("D5")
sDFolder = Range("D" & CStr(iRow)).Value

Set FSO = CreateObject("Scripting.FileSystemObject")

sFileType = ".pdf" ' TRY WITH OTHER FILE TYPES LIKE ".pdf".

' LOOP THROUGH COLUMN "B" TO PICK THE FILES.
While bContinue

If Len(Range("B" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK.
MsgBox "Process executed" ' DONE.
bContinue = False
Else
' CHECK IF FILES EXISTS.

If Len(Dir(sSFolder & Range("B" & CStr(iRow)).Value & sFileType)) = 0 Then
Range("C" & CStr(iRow)).Value = "Does Not Exists"
Range("C" & CStr(iRow)).Font.Bold = True
Else
Range("C" & CStr(iRow)).Value = "On Hand"
Range("C" & CStr(iRow)).Font.Bold = False


If Trim(sDFolder) <> "" Then
Dim objFSO
Set objFSO = CreateObject("scripting.filesystemobject")

' CHECK IF DESTINATION FOLDER EXISTS.
If objFSO.FolderExists(sDFolder) = False Then
MsgBox sDFolder & " Does Not Exists"
Exit Sub
End If

'*****
' HERE I HAVE INCLUDED TWO DIFFERENT METHODS.
' I HAVE COMMENTED THE SECOND METHOD. TO THE SEE THE RESULT OF THE
' SECOND METHOD, UNCOMMENT IT AND COMMENT THE FIRST METHOD.

' METHOD 1) - USING "CopyFile" METHOD TO COPY THE FILES.
objFSO.CopyFile Source:=sSFolder & Range("B" & CStr(iRow)).Value & _
sFileType, Destination:=sDFolder

' METHOD 2) - USING "MoveFile" METHOD TO PERMANENTLY MOVE THE FILES.
'objFSO.MoveFile Source:=sSFolder & Range("B" & CStr(iRow)).Value & _
sFileType, Destination:=sDestinationPath
'*****
End If
End If
End If

iRow = iRow + 1 ' INCREMENT ROW COUNTER.
Wend
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
You have to put the line where I indicated you:


Code:
Option Explicit
Sub CopyFiles()
    Dim FSO
    Dim iRow As Integer ' ROW COUNTER.
    Dim sSFolder As String
    Dim sDFolder As String
    Dim sFileType As String
    
    Dim bContinue As Boolean
    
    bContinue = True
    iRow = 2
    
    ' THE SOURCE AND DESTINATION FOLDER WITH PATH.
    sSFolder = Sheets("Book1").Range("D5")
    '[COLOR=#ff0000]sDFolder = Sheets("Book1").Range("D6")  'delete this line[/COLOR]
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    sFileType = ".pdf" ' TRY WITH OTHER FILE TYPES LIKE ".pdf".
    
    ' LOOP THROUGH COLUMN "B" TO PICK THE FILES.
    While bContinue
    
        If Len(Range("B" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK.
            MsgBox "Process executed" ' DONE.
            bContinue = False
        Else
            ' CHECK IF FILES EXISTS.
            
            If Len(Dir(sSFolder & Range("B" & CStr(iRow)).Value & sFileType)) = 0 Then
                Range("C" & CStr(iRow)).Value = "Does Not Exists"
                Range("C" & CStr(iRow)).Font.Bold = True
            Else
                Range("C" & CStr(iRow)).Value = "On Hand"
                Range("C" & CStr(iRow)).Font.Bold = False
                
[SIZE=3][B][COLOR=#0000cd]                sDFolder = Range("[/COLOR][COLOR=#ff0000]D[/COLOR][COLOR=#0000cd]" & CStr(iRow)).Value  '[/COLOR][/B][/SIZE][B]here goes the line[/B]
                
                If Trim(sDFolder) <> "" Then
                    Dim objFSO
                    Set objFSO = CreateObject("scripting.filesystemobject")
                    
                    ' CHECK IF DESTINATION FOLDER EXISTS.
                    If objFSO.FolderExists(sDFolder) = False Then
                        MsgBox sDFolder & " Does Not Exists"
                        Exit Sub
                    End If
                    
                    '*****
                    ' HERE I HAVE INCLUDED TWO DIFFERENT METHODS.
                    ' I HAVE COMMENTED THE SECOND METHOD. TO THE SEE THE RESULT OF THE
                    ' SECOND METHOD, UNCOMMENT IT AND COMMENT THE FIRST METHOD.
                    
                    ' METHOD 1) - USING "CopyFile" METHOD TO COPY THE FILES.
                    objFSO.CopyFile Source:=sSFolder & Range("B" & CStr(iRow)).Value & _
                    sFileType, Destination:=sDFolder
                    
                    ' METHOD 2) - USING "MoveFile" METHOD TO PERMANENTLY MOVE THE FILES.
                    'objFSO.MoveFile Source:=sSFolder & Range("B" & CStr(iRow)).Value & _
                    sFileType, Destination:=sDestinationPath
                    '*****
                End If
            End If
        End If
        
        iRow = iRow + 1 ' INCREMENT ROW COUNTER.
    Wend
End Sub
 

Shammas

New Member
Joined
Apr 7, 2019
Messages
5

ADVERTISEMENT

Thank you for your valuable response,

It works

Grate!!!
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
You're welcome and thanks for the feedback
 

Shammas

New Member
Joined
Apr 7, 2019
Messages
5
Hi,

I was trying to make the source folder also to copy from a list but it is not working, do you have any solution please help me, the below are the new program i prepared

Option Explicit
Sub MoveFiles()
Dim FSO
Dim iRow As Integer ' ROW COUNTER.
Dim sSFolder As String
Dim sDFolder As String
Dim sFileType As String

Dim bContinue As Boolean

bContinue = True
iRow = 2


Set FSO = CreateObject("Scripting.FileSystemObject")



sFileType = ".pdf" ' TRY WITH OTHER FILE TYPES LIKE ".pdf".




' LOOP THROUGH COLUMN "B" TO PICK THE FILES.
While bContinue

If Len(Range("B" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK.
MsgBox "Process executed" ' DONE.
bContinue = False
Else

' CHECK IF FILES EXISTS.

If Len(Dir(sSFolder & Range("B" & CStr(iRow)).Value & sFileType)) = 0 Then
Range("C" & CStr(iRow)).Value = "Does Not Exists"
Range("C" & CStr(iRow)).Font.Bold = True
Else
Range("C" & CStr(iRow)).Value = "On Hand"
Range("C" & CStr(iRow)).Font.Bold = False

' THE SOURCE AND DESTINATION FOLDER WITH PATH.

sSFolder = Range("F" & CStr(iRow)).Value 'New change for picking files from different path folder'
sDFolder = Range("D" & CStr(iRow)).Value 'here goes the line


If Trim(sDFolder) <> "" Then
Dim objFSO
Set objFSO = CreateObject("scripting.filesystemobject")


' CHECK IF DESTINATION FOLDER EXISTS.
If objFSO.FolderExists(sDFolder) = False Then
MsgBox sDFolder & " DESTINATION Does Not Exists"
Exit Sub
End If

'*****
' HERE I HAVE INCLUDED TWO DIFFERENT METHODS.
' I HAVE COMMENTED THE SECOND METHOD. TO THE SEE THE RESULT OF THE
' SECOND METHOD, UNCOMMENT IT AND COMMENT THE FIRST METHOD.

' METHOD 1) - USING "MoveFile" METHOD TO Move THE FILES.
objFSO.MoveFile Source:=sSFolder & Range("B" & CStr(iRow)).Value & _
sFileType, Destination:=sDFolder

' METHOD 2) - USING "MoveFile" METHOD TO PERMANENTLY MOVE THE FILES.
'objFSO.MoveFile Source:=sSFolder & Range("B" & CStr(iRow)).Value & _
sFileType, Destination:=sDestinationPath
'*****
End If
End If
End If

iRow = iRow + 1 ' INCREMENT ROW COUNTER.
Wend
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,123,265
Messages
5,600,603
Members
414,393
Latest member
Vignesh Mechz

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
Top