file system objects

Simi

New member
Joined
Feb 10, 2012
Messages
190
Reaction score
0
Points
0
Location
Utah, USA
Excel Version(s)
Version 2002 Build 12527.20194
I am trying to cleanup some old files and want a macro to move my old files to a new folder.

I have a folder called Simi, that has sub folders in it a, b, c. The folder Simi also has files in it.

What I want is for a new folder named 2013 to be created in every folder that has files created in 2013, then move the files to the respective folders.

so in the folder Simi, we would end up with 4 folders, a, b, c, 2013.
in folder a would also be a 2013 folder.
in folder b there were no files created in 2013 so it gets skip'd
in folder c there is a 2013 folder.

I don't know if this is making sense or not.

Attached is the workbook with the code I am using.
In its current form, I am getting a duplicate 2013 folder. Simi/2013/2013
my problem is, I don't want it going into the subfolders of a, b, c. so I can't just call the consolidate sub again.
 

Attachments

  • cleanup-folders.xlsm
    21.1 KB · Views: 11
try this code
Code:
Sub TestMe()
    Dim sFolder As String
    sFolder = "C:\test\" ' >>>>>> to be changed
    'sFolder = BrowseFolder("Select Directory")
   
    Call Consolidate(sFolder, ThisWorkbook)
End Sub

Private Sub Consolidate(strFolder As String, wbMaster As Workbook)
    
    Dim objFso As Object
    Dim objFiles As Object
    Dim objSubFolder As Object
    Dim objSubFolders As Object
    Dim objFile As Object
    Dim ary(3) As Variant
    Dim lRow As Long
    Dim sFolder As String

    'Create objects to enumerate files and folders
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFiles = objFso.getfolder(strFolder).Files
    Set objSubFolders = objFso.getfolder(strFolder).subFolders
        
    
Set objFiles = objFso.getfolder(strFolder).Files
For Each objFile In objFiles
    If Year(objFile.datecreated) = 2013 Then
        sFolder = Left(objFile.Path, Len(objFile.Path) - Len(objFile.Name))
        If FileFolderExists(sFolder & "2013") Then
            'folder exists
        Else
            'create the folder
            objFso.createfolder (sFolder & "2013\")
        End If
        sFolder = sFolder & "2013\"
        objFile.Move sFolder
    End If
        
Next objFile

'Loop through each file in the folder
For Each objSubFolder In objSubFolders
  If InStr(objSubFolder, "2013") = 0 Then
    Set objFiles = objFso.getfolder(objSubFolder).Files
    For Each objFile In objFiles
      If Year(objFile.datecreated) = 2013 Then
        sFolder = Left(objFile.Path, Len(objFile.Path) - Len(objFile.Name))
        
        If FileFolderExists(sFolder & "2013") Then
            'folder exists
        Else
            'create the folder
            objFso.createfolder (sFolder & "2013\")
        End If
        sFolder = sFolder & "2013\"
        objFile.Move sFolder
      End If
        
    Next objFile
  End If
Next objSubFolder

Function BrowseFolder(Title As String, _
    Optional InitialView As Office.MsoFileDialogView = _
        msoFileDialogViewList) As String
    Dim V As Variant
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = Title
        .InitialView = InitialView
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            V = vbNullString
        End If
    End With
    BrowseFolder = CStr(V)
End Function

Public Function FileFolderExists(strFullPath As String) As Boolean
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function
 
Back
Top