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

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

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,118,889
Messages
5,574,846
Members
412,620
Latest member
sharma7s
Top