nmkhan3010
New Member
- Joined
- Feb 1, 2020
- Messages
- 23
- Office Version
- 2016
- Platform
- Windows
Am having two folders “A” & “B” in A folder having 1000 files (word & rtf files) I need to copy only 10 files form the 1000 files (A folder) to B (folder). Is there any VBA code in excel for folder searching and copying.
10 files list is given excel column “B”
In column, C updated as “MOVED” if document found in A folder and moved to B folder
In column, C updated as “Does Not Exists” if document not found in A folder and gives an message.
Please modified the below code and it should be ask for source path and move to specific folder as not by default like below one’s.
Please do the needful and thanks in advance
Below code copied from other online sources only.....
Option Explicit
Sub CopyFiles()
Dim iRow As Integer ' ROW COUNTER.
Dim sSourcePath As String
Dim sDestinationPath As String
Dim sFileType As String
Dim bContinue As Boolean
bContinue = True
iRow = 2
' THE SOURCE AND DESTINATION FOLDER WITH PATH.
sSourcePath = "C:\Users\nkhaja\Desktop\PRODUCTION\2020\FEBRUARY\24-02-2020\14264660"
sDestinationPath = "C:\Users\nkhaja\Desktop\PRODUCTION\2020\FEBRUARY\24-02-2020\16580453"
sFileType = ".docx"
sFileType = ".rtf"
' 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(sSourcePath & 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 = "MOVED"
Range("C" & CStr(iRow)).Font.Bold = False
If Trim(sDestinationPath) <> "" Then
Dim objFSO
Set objFSO = CreateObject("scripting.filesystemobject")
' CHECK IF DESTINATION FOLDER EXISTS.
If objFSO.FolderExists(sDestinationPath) = False Then
MsgBox sDestinationPath & " 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:=sSourcePath & Range("B" & CStr(iRow)).Value & _
sFileType, Destination:=sDestinationPath
' 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
End Sub
10 files list is given excel column “B”
In column, C updated as “MOVED” if document found in A folder and moved to B folder
In column, C updated as “Does Not Exists” if document not found in A folder and gives an message.
Please modified the below code and it should be ask for source path and move to specific folder as not by default like below one’s.
Please do the needful and thanks in advance
Below code copied from other online sources only.....
Option Explicit
Sub CopyFiles()
Dim iRow As Integer ' ROW COUNTER.
Dim sSourcePath As String
Dim sDestinationPath As String
Dim sFileType As String
Dim bContinue As Boolean
bContinue = True
iRow = 2
' THE SOURCE AND DESTINATION FOLDER WITH PATH.
sSourcePath = "C:\Users\nkhaja\Desktop\PRODUCTION\2020\FEBRUARY\24-02-2020\14264660"
sDestinationPath = "C:\Users\nkhaja\Desktop\PRODUCTION\2020\FEBRUARY\24-02-2020\16580453"
sFileType = ".docx"
sFileType = ".rtf"
' 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(sSourcePath & 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 = "MOVED"
Range("C" & CStr(iRow)).Font.Bold = False
If Trim(sDestinationPath) <> "" Then
Dim objFSO
Set objFSO = CreateObject("scripting.filesystemobject")
' CHECK IF DESTINATION FOLDER EXISTS.
If objFSO.FolderExists(sDestinationPath) = False Then
MsgBox sDestinationPath & " 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:=sSourcePath & Range("B" & CStr(iRow)).Value & _
sFileType, Destination:=sDestinationPath
' 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
End Sub