nmkhan3010
04-14-2020, 11:45 AM
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............
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............