Copy files from one Location to another

[nmkhan3010]

Hi,

below code is copying files from one location to another but if i had same file with different versions like 123.doc , 123.docx , 123.pdf it is copying only pdf version, can anyone review and do the needful..

i want to copy all files related to the excel based value like if i give 123 as value in excel all the files related to 123 such as 123.doc , 123-native.doc , 123-english.doc , 123-converted.pdf are to be copied from source to destination folder.

your help is highly appreciated thank you....

For reference PFA.

Code:

Sub CopyFiles1()                          ''                  Code
 Dim iRow As Integer ' ROW COUNTER.
 Dim SourcePath As String
 Dim DestinationPath As String
 Dim sFileType As String
 
 Dim bContinue As Boolean
 
 bContinue = True
 iRow = 2
 
 ' THE SOURCE AND DESTINATION FOLDER WITH PATH.
 
SourcePath = InputBox("PLEASE ENTER PATH", "SOURCE PATH") & "\"
DestinationPath = InputBox("PLEASE ENTER PATH", "DESTINATION PATH") & "\"
 
 sFileType = ".docx"
 sFileType = ".rtf"
 sFileType = ".pdf"
 
 ' LOOP THROUGH COLUMN "B" TO PICK THE FILES.
 While bContinue
 
 If Len(Range("A" & 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(SourcePath & Range("A" & CStr(iRow)).Value & sFileType)) = 0 Then
 Range("B" & CStr(iRow)).Value = "Does Not Exists"
 Range("B" & CStr(iRow)).Font.Bold = True
 Else
 Range("B" & CStr(iRow)).Value = "Copied"
  Range("B" & CStr(iRow)).Font.Bold = False
 
 If Trim(DestinationPath) <> "" Then
 Dim objFSO
 Set objFSO = CreateObject("scripting.filesystemobject")
 
 ' CHECK IF DESTINATION FOLDER EXISTS.
 If objFSO.FolderExists(DestinationPath) = False Then
 MsgBox DestinationPath & " 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:=SourcePath & Range("A" & CStr(iRow)).Value & _
 sFileType, Destination:=DestinationPath
 
 ' METHOD 2) - USING "MoveFile" METHOD TO PERMANENTLY MOVE THE FILES.
 'objFSO.MoveFile Source:=sSourcePath & Range("B" & CStr(iRow)).Value & _
 sFileType, Destination:=sDestinationPath
 '*****
 End If
 End If
 End If
 
 iRow = iRow + 1 ' INCREMENT ROW COUNTER.
 Wend
 Set objFSO = Nothing
 
End Sub

Thanks in Advance............