Results 1 to 2 of 2

Thread: file system objects

  1. #1
    Conjurer Simi's Avatar
    Join Date
    Feb 2012
    Location
    Utah, USA
    Posts
    187
    Articles
    0

    file system objects



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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.
    Attached Files Attached Files

  2. #2
    Acolyte patel's Avatar
    Join Date
    Feb 2014
    Location
    Italy
    Posts
    59
    Articles
    0
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •