Morning!
So I have a parent folder (labeled "2017") with some subfolders (Labeled "Month 1", "Month 2", etc etc) and some subfolders (labeled "Week 1", "Week 2", etc etc) in the Month folders. The Week folders also have some subfolders, i.e. "Completed", and some other non-important folders. I have some code that allows me to select the month folder that I need data from and copy all files in that month folder and all subfolders within the month folder.
Ex: I select Month 1, it copies all files in the Month 1 folder, and all the files in all subfolders under Month 1 (i.e. Week 1, Completed, ABC, XYZ, etc.)
The issue I am having is that I don't want all files from Month 1 and all files from all subfolders. What I need is when I select Month 1, I need to copy only files from subfolders labeled "Completed", that are under Month 1.
Ex: I select Month 1, the code goes into all subfolders in Month 1, and subfolders within subfolders within subfolders etc etc, until it finds all folders labeled "Completed", (sans ""). It then copies all files (not folders) from all the "Completed" folders to my destination folder, which resides directly in the Month 1 folder.
The issue I am having is getting the code to search for only the "Completed" folders and copy only the files from the "Completed" folders.
Any assistance, ideas, pointing in the right direction, discussion, etc, is very much and greatly appreciated! I am racking my brain and cannot figure this one out.
Here is the code so far (FYI, this is not all mine so I do not take credit for it. I have pieced portions and chunks together and added pieces of my own to it to make it work so far, perhaps that is where my error lies .....)
So I have a parent folder (labeled "2017") with some subfolders (Labeled "Month 1", "Month 2", etc etc) and some subfolders (labeled "Week 1", "Week 2", etc etc) in the Month folders. The Week folders also have some subfolders, i.e. "Completed", and some other non-important folders. I have some code that allows me to select the month folder that I need data from and copy all files in that month folder and all subfolders within the month folder.
Ex: I select Month 1, it copies all files in the Month 1 folder, and all the files in all subfolders under Month 1 (i.e. Week 1, Completed, ABC, XYZ, etc.)
The issue I am having is that I don't want all files from Month 1 and all files from all subfolders. What I need is when I select Month 1, I need to copy only files from subfolders labeled "Completed", that are under Month 1.
Ex: I select Month 1, the code goes into all subfolders in Month 1, and subfolders within subfolders within subfolders etc etc, until it finds all folders labeled "Completed", (sans ""). It then copies all files (not folders) from all the "Completed" folders to my destination folder, which resides directly in the Month 1 folder.
The issue I am having is getting the code to search for only the "Completed" folders and copy only the files from the "Completed" folders.
Any assistance, ideas, pointing in the right direction, discussion, etc, is very much and greatly appreciated! I am racking my brain and cannot figure this one out.
Here is the code so far (FYI, this is not all mine so I do not take credit for it. I have pieced portions and chunks together and added pieces of my own to it to make it work so far, perhaps that is where my error lies .....)
Code:
Sub Copy_Excel_Files()
Dim a, b() As String
Dim i As Long, j As Long
Dim sFolderSource As String
Dim sFolderDestination As String
Dim sPath As String
Dim FSO As FileSystemObject
Dim col As VBA.Collection
Dim wb As Workbook
Dim SourcePath As String
Dim DestinationPath As String
MsgBox "Please choose source folder", , "Source Folder"
Application.DisplayAlerts = False
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> -1 Then MsgBox "No Folder(s) Selected! Exiting script.": Exit Sub
SourcePath = .SelectedItems(1)
DestinationPath = .SelectedItems(1)
End With
sFolderSource = SourcePath
sFolderDestination = DestinationPath & "\Saved\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set col = New VBA.Collection
a = Directory_List(sFolderSource, True, True)
If Not IsEmpty(a) Then
With FSO
For i = 0 To UBound(a)
If InStr(1, a(i), "xls") > 0 Then
j = 0
sPath = sFolderDestination & IIf(Right(sPath, 1) <> "\", "\", "")
sPath = sPath & .GetBaseName(a(i))
Do While .FileExists(sPath & IIf(j, "_" & Format(j, "000"), "") _
& "." & .GetExtensionName(a(i)))
j = j + 1
Loop
sPath = sPath & IIf(j, "_" & Format(j, "000"), "") _
& "." & .GetExtensionName(a(i))
On Error Resume Next
FSO.CopyFile a(i), sPath
On Error GoTo 0
If Not .FileExists(sPath) Then
col.Add a(i)
End If
End If
Next
End With
If col.Count > 0 Then
Set wb = Workbooks.Add
With wb.Worksheets(1)
.Cells(1, 1).Value = "COPY ERRORS"
For i = 1 To col.Count
.Cells(i, 1).Offset(1).Value = col(i)
Next i
End With
Else
MsgBox "Complete. No copy errors found. "
End If
Else
MsgBox "No excel files found. "
End If
End Sub
Public Function Directory_List(ByVal startInFolder As String, _
Optional includeImmediateSubFolders As Boolean = False, _
Optional includeAllSubFolders As Boolean = False) As Variant
Dim a() As String '//Array to hold filepaths
Dim i As Long '//Counter of files found
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
ReDim a(0 To 0)
Call Directory_List_Main(FSO, a, i, _
startInFolder, _
includeImmediateSubFolders, _
includeAllSubFolders)
If i > 0 Then
Directory_List = a
End If
Set FSO = Nothing
End Function
Private Sub Directory_List_Main(ByRef FSO As Object, ByRef a() As String, ByRef i As Long, _
ByRef startInFolder As String, _
Optional includeImmediateSubFolders As Boolean = False, _
Optional includeAllSubFolders As Boolean = False)
Dim MyFolder As Folder
Dim mySubfolder As Folder
Dim f As File
Dim msg As String
On Error GoTo Handler
If Not (FSO.FolderExists(startInFolder)) Then
msg = "Error. Folder not Found:" & vbNewLine & startInFolder
MsgBox msg, vbExclamation
Exit Sub
End If
With FSO
Set MyFolder = .GetFolder(startInFolder)
For Each f In MyFolder.Files
ReDim Preserve a(0 To i)
a(i) = f.Path
i = i + 1
Next f
If (includeImmediateSubFolders Or includeAllSubFolders) Then
For Each mySubfolder In MyFolder.SubFolders
Call Directory_List_Main(FSO, a, i, _
mySubfolder.Path, _
includeAllSubFolders, _
includeAllSubFolders)
Next mySubfolder
End If
End With
My_Exit:
Exit Sub
Handler:
MsgBox "Error in Sub Directory_List_Main" & Err.Number & " " & Err.Description
Set FSO = Nothing
Resume My_Exit
End Sub
Last edited:
