Page 1 of 2 1 2 LastLast
Results 1 to 10 of 13

Thread: Need help with File System Object code.

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

    Need help with File System Object code.



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

    I am trying to clean up some files and need some help with using the File System Object and going through folders.
    I have tried using some counters to figure out how many files I am trying to copy, but I seem to be error-ing out before it runs on all the folders/files.

    Can someone please help with where I am missing something.

    Code:
    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
        'Set Error Handling
        On Error GoTo EarlyExit
        Dim lCounter As Long
    
    
        'Create objects to enumerate files and folders
        Set objFso = CreateObject("Scripting.FileSystemObject")
        Set objFiles = objFso.getfolder(strFolder).Files
        Set objSubFolders = objFso.getfolder(strFolder).subFolders
        
    lRow = 1
    lCounter = 0
    
    
    Set objFiles = objFso.getfolder(strFolder).Files
    For Each objFile In objFiles
        With ActiveSheet
            If objFile.datelastmodified > .Range("I1") Then
                .Range("A" & lRow) = objFile.Path
                .Range("C" & lRow) = objFile.datelastmodified
                sFolder = Left(objFile.Path, Len(objFile.Path) - Len(objFile.Name) - 1)
                sFolder = "T" & Right(sFolder, Len(sFolder) - 1)
                Range("B" & lRow) = sFolder
                'sFolder = Left(objFile.Path, Len(objFile.Path) - Len(objFile.Name))
                '.Range("D" & lRow) = sFolder
                If FileFolderExists(sFolder & "") Then
                    'folder exists
                Else
                    'create the folder
                    objFso.createfolder (sFolder & "\")
                End If
                
                sFolder = sFolder & "\"
                objFile.Copy sFolder
                lRow = lRow + 1
            End If
            .Range("I2") = .Range("I2") + 1
        End With
    
    
        lCounter = lCounter + 1
    Next objFile
    
    
    'Go in sub folders and continue.
        For Each objSubFolder In objSubFolders
            Consolidate objSubFolder.Path, wbMaster
        Next objSubFolder
    
    
    With ActiveSheet
        .Range("I3") = lCounter
    End With
    
    
    EarlyExit:
        'Clean up
        On Error Resume Next
        Set objFile = Nothing
        Set objFiles = Nothing
        Set objFso = Nothing
        On Error GoTo 0
    End Sub

  2. #2
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,356
    Articles
    0
    Excel Version
    365
    I think one problem could be:

    objFso.createfolder (sFolder & "\")

    I think this only adds one subfolder to an existing folder and if the path doesn't exist up to the penultimate folder, it errors.
    Since you're using recursion, it could be that some subfolders contain no files after the date in I1, so recursion moves on without creating the intermediate folders. If a file is encountered which has a date after the date in I1 the createfolder will fail.
    I haven't dreamt up a solution yet but it would involve testing for the folders in the path one by one and creating them if needed. If I get time I'll look at this.

    Taking out the On Error line during development helps in debugging.

  3. #3
    Conjurer Simi's Avatar
    Join Date
    Feb 2012
    Location
    Utah, USA
    Posts
    187
    Articles
    0
    Oh that was a really great idea p45cal. I am going to change it to create a duplicate folder structure as it goes and not have the folder creation as part of the date check. That should help with my problem. I was worried when I ran this because it worked really well on the sample data I was using, but when I ran it on my main folder it didn't check all the files. It ran some 160,000 files but there are 250,000+ files that needed to be checked.

    I will post back if I get better results.

  4. #4
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,356
    Articles
    0
    Excel Version
    365
    The following worked here without the On Error line being active.
    Code:
    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
    'Set Error Handling
    'On Error GoTo EarlyExit
    Dim lCounter As Long
    
    'Create objects to enumerate files and folders
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFiles = objFso.getfolder(strFolder).Files
    Set objSubFolders = objFso.getfolder(strFolder).subFolders
    
    'lRow = 1
    lCounter = 0
    
    Set xxx = objFso.getfolder(strFolder)
    'If xxx.Attributes <> 16 Then Debug.Print xxx.Attributes
    If xxx.Attributes <> 1046 Then 'skip folders like My Music, My Videos which are links
      Set objFiles = objFso.getfolder(strFolder).Files
      For Each objFile In objFiles
        With ActiveSheet
          If objFile.datelastmodified > .Range("I1") Then
          lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Range("A" & lRow) = objFile.Path
            .Range("C" & lRow) = objFile.datelastmodified
            sFolder = Left(objFile.Path, Len(objFile.Path) - Len(objFile.Name) - 1)
            .Range("B" & lRow) = sFolder
            sFolder = "T" & Right(sFolder, Len(sFolder) - 1)
            'objFso.CopyFile objFile.Path, Replace(objFile.parentfolder.Path, "C:\", "T:\")
            'sFolder = Left(objFile.Path, Len(objFile.Path) - Len(objFile.Name))
            .Range("D" & lRow) = sFolder
            If Not FileFolderExists(sFolder & "") Then CreateFolderStructureAsRequired "T", objFile, objFso
            sFolder = sFolder & "\"
            If objFile.Name <> "Outlook.pst" Then objFile.Copy sFolder
            'lRow = lRow + 1
          End If
          .Range("I2") = .Range("I2") + 1
        End With
        lCounter = lCounter + 1
      Next objFile
      'Go in sub folders and continue.
      For Each objSubFolder In objSubFolders
        Consolidate objSubFolder.Path, wbMaster
      Next objSubFolder
    End If
    ActiveSheet.Range("I3") = lCounter
    
    EarlyExit:
    'Clean up
    On Error Resume Next
    Set objFile = Nothing
    Set objFiles = Nothing
    Set objFso = Nothing
    On Error GoTo 0
    End Sub
    Code:
    Public Function FileFolderExists(strFullPath As String) As Boolean
    'Author       : Ken Puls (www.excelguru.ca)
    'Macro Purpose: Check if a file or folder exists
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
    End Function
    Code:
    Sub CreateFolderStructureAsRequired(DestnDriveLetter, SourceFile, fso)
    Dim myStrFolder As String
    yy = Split(SourceFile.Path, Application.PathSeparator)
    myStrFolder = DestnDriveLetter & ":" & Application.PathSeparator
    For i = 1 To UBound(yy) - 1
      myStrFolder = myStrFolder & yy(i) & Application.PathSeparator
      If Not FileFolderExists(myStrFolder) Then fso.createfolder myStrFolder
    Next i
    End Sub

  5. #5
    Conjurer Simi's Avatar
    Join Date
    Feb 2012
    Location
    Utah, USA
    Posts
    187
    Articles
    0
    Well as an update I have changed this to duplicate the folder structure regardless of the file needing to be copied.
    It seems to be working to duplicate the structure, I can't run it to copy my files yet, I have to wait until no one is here using the server.

    this is what I changed it to.

    Code:
    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
        'Set Error Handling
        On Error GoTo EarlyExit
        Dim lCounter As Long
    
    
        'Create objects to enumerate files and folders
        Set objFso = CreateObject("Scripting.FileSystemObject")
        Set objFiles = objFso.getfolder(strFolder).Files
        Set objSubFolders = objFso.getfolder(strFolder).subFolders
    With ActiveSheet
        lRow = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Row
    End With
    lCounter = 0
    
    
    Set objFiles = objFso.getfolder(strFolder).Files
    For Each objFile In objFiles
    Exit For 'testing folder creation only
        With ActiveSheet
            sFolder = Left(objFile.Path, Len(objFile.Path) - Len(objFile.Name) - 1)
            sFolder = "T" & Right(sFolder, Len(sFolder) - 1)
            If objFile.datelastmodified > .Range("I1") Then
                .Range("A" & lRow) = objFile.Path
                .Range("C" & lRow) = objFile.datelastmodified
                sFolder = sFolder & "\"
                objFile.Copy sFolder
                lRow = lRow + 1
            End If
            .Range("I2") = .Range("I2") + 1
        End With
    
    
        lCounter = lCounter + 1
    Next objFile
    
    
    'Go in sub folders and continue.
    For Each objSubFolder In objSubFolders
        sFolder = objSubFolder.Path
        sFolder = "T" & Right(sFolder, Len(sFolder) - 1)   
        If FileFolderExists(sFolder & "") Then
            'folder exists
        Else
            'create the folder
            objFso.createfolder (sFolder & "\")
        End If
        Consolidate objSubFolder.Path, wbMaster
    Next objSubFolder
    
    
    With ActiveSheet
        .Range("I3") = lCounter
    End With
    
    
    EarlyExit:
        'Clean up
        On Error Resume Next
        Set objFile = Nothing
        Set objFiles = Nothing
        Set objFso = Nothing
        On Error GoTo 0
    End Sub

  6. #6
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,356
    Articles
    0
    Excel Version
    365
    Quote Originally Posted by Simi View Post
    Well as an update I have changed this to duplicate the folder structure regardless of the file needing to be copied.
    We seem to have posted at almost the same time. I've tried only to re-create the folders necessary, that way you're not for ever searching for files in empty folders.
    After resolving the error caused by trying to create folders, another error cropped up being 'permission denied' to folders which were shortcuts or links, hence my:

    If xxx.Attributes <> 1046 Then

    but with that, no further errors were encountered.

  7. #7
    Conjurer Simi's Avatar
    Join Date
    Feb 2012
    Location
    Utah, USA
    Posts
    187
    Articles
    0
    Thank you p45cal, I wish I knew more about this type of coding.
    I will try this tonight or tomorrow when no one else is using the server.
    Thank you for the help.

  8. #8
    Conjurer Simi's Avatar
    Join Date
    Feb 2012
    Location
    Utah, USA
    Posts
    187
    Articles
    0
    Well, I ran into a problem while running your code.
    I ended up trying to copy a file that I don't have permissions on.
    Is there a way to skip those type of files?
    but also, include those files in my list of files that were copied, with another note that it was permission denied.

  9. #9
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,356
    Articles
    0
    Excel Version
    365
    Well we could for example do something similar to what I did with a line (which I shouldn't have left as is):
    If objFile.Name <> "Outlook.pst" Then objFile.Copy sFolder
    (It was because I was copying a huge .pst file which was slowing down my testing).
    We'd need to establish whether it was the folder or the file that was denying you permissions.
    This one was testing the folder:
    If xxx.Attributes <> 1046 Then 'skip folders like My Music, My Videos which are links
    So it's a matter of stepping through the code when the error is encountered and seeing what's different about the file/folder, so that we can note that it has not been copied etc.
    Use the Locals pane to set and examine the properties of objects.

    If you want we could do a TeamViewer session?

  10. #10
    Conjurer Simi's Avatar
    Join Date
    Feb 2012
    Location
    Utah, USA
    Posts
    187
    Articles
    0
    How do you know what number to use for the attributes line, the 1046?
    Also, I have just re-enabled the on error line.
    I also added a check to see how many folders are accessed.
    I am now coming up with, this running on 252829 files in 15455 folders. My problem is there are 252903 files in 15472 folders.
    I can't afford to be "missing" these files and folders.

    Thank you again for your time and help on this issue p45cal.

Page 1 of 2 1 2 LastLast

Posting Permissions

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