binar
04-14-2020, 06:58 PM
Fellow Forum Members,
Here is my hypothetical example to keep it all simple. Let's say I have around 1,500 photos located within the 5 sub-folders in the 2018 folder shown below:
C:\PHOTOS
└───2018
├───2018-01
├───2018-02
├───2018-03
├───2018-04
└───2018-05
Now let's say I also have an Excel365 list of 200 JPG file names I want to have physically moved (not copied) from the 5 sub-folders shown above over to the "Favorite_Photos" destination folder location in the path shown below:
C:\PHOTOS
└───Favorite_Photos
Below is a VBA code example I found online and it does not do what I need it to do. I need my VBA code to search the sub-folders for JPG file names from the list in a drill down manner. It also copies the files and does not subtract them from the source sub-folders which is not good for me.
I am not a VBA coder, therefore I would be very appreciative if somebody in this community can be so kind to modify the VBA code below so it works as I described above.
Additionally, is there an open source Windows10 software app that can move files using a control file list? Again, any help will be greatly appreciated.
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:\books\"
sDestinationPath = "C:\booksforclient\"
sFileType = ".jpg" ' 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 = "On Hand"
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
Here is my hypothetical example to keep it all simple. Let's say I have around 1,500 photos located within the 5 sub-folders in the 2018 folder shown below:
C:\PHOTOS
└───2018
├───2018-01
├───2018-02
├───2018-03
├───2018-04
└───2018-05
Now let's say I also have an Excel365 list of 200 JPG file names I want to have physically moved (not copied) from the 5 sub-folders shown above over to the "Favorite_Photos" destination folder location in the path shown below:
C:\PHOTOS
└───Favorite_Photos
Below is a VBA code example I found online and it does not do what I need it to do. I need my VBA code to search the sub-folders for JPG file names from the list in a drill down manner. It also copies the files and does not subtract them from the source sub-folders which is not good for me.
I am not a VBA coder, therefore I would be very appreciative if somebody in this community can be so kind to modify the VBA code below so it works as I described above.
Additionally, is there an open source Windows10 software app that can move files using a control file list? Again, any help will be greatly appreciated.
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:\books\"
sDestinationPath = "C:\booksforclient\"
sFileType = ".jpg" ' 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 = "On Hand"
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