In a excel Column A is File Names & Column B is Status
I want to copy a files through browse option to select a source folder from where to copy and then through browse option to select a target folder to be pasted here(based on excel file names match cases).
Column A is File Names
Column B is Status (If the file is available then update as Copied, If N/A then update as Does not Exists)
In source Folder each file name has three different formats( 123.docx , 123.rtf , 123.pdf)
When 123 file name has matched then copied all the formats to the target folder & If the same file was already available in the target folder then ask for confirmation as "File Already exists, do you want replace (Yes or No).
I had a code but which is not working effective only one format is copying and please anyone ammend the above changes to the below code.
If anyone helps me in this regards am very thankful.....
Please find the base code below & Attachment:
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 "A" 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