FSO Not Getting Any Files

Question

I'm trying to have the program to copy the files with certain characters. The files to be copied over should be between the today's date and 100 days before today. My program can run, but nothing show up on the new folder. I did make sure that the file is between those date. I don't get any error, so I have no idea where to fix. I have tried other methods, none of them working.

I try to mix the code from http://www.rondebruin.nl/win/s3/win026.htm. I was playing abround with it, only copy_folder() is working. I'm getting runtime error '53' - File not found on Copy_Certain_Files_In_Folder() and Copy_Files_Dates() give me nothing as well.

Anyway, what is wrong with my code and how can I incorporate the FileExt to my code below? Thanks!

Sub CopyPasteFiles()

Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Fdate As Date
Dim FileExt As String
Dim objFile As Object
Dim objFolder As Object

FromPath = "C:\Users\Run"  '<< Change
ToPath = "C:\Users\Test"    '<< Change
FileExt = "*BT.csv"

If Right(FromPath, 1) <> "\" Then
    FromPath = FromPath & "\"
End If

Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(FromPath) = False Then
    MsgBox FromPath & " doesn't exist"
    Exit Sub
End If

If FSO.FolderExists(ToPath) = False Then
    MsgBox ToPath & " doesn't exist"
    Exit Sub
End If

For Each objFolder In FSO.GetFolder(FromPath).SubFolders
    For Each objFile In objFolder.Files
            Fdate = Int(objFile.DateCreated)
            If Fdate >= Date And Fdate <= Format(DateAdd("d", -100, Date), "dd mmmm yyyy") Then
                objFile.Copy ToPath
            End If
    Next objFile
Next objFolder

MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub

Answer 1

Okay, I tried to add some comments to give you some direction. The first problem you had, is you weren't doing anything with the root folder - you were trying to go right into the subfolders, which is probably why you said it "highlighted" the lines on the outer loop layer. (The highlighted line is the line that will be executed when you hit F8 next.)

What I did was break the copy action into another procedure so you can call it recursively on any subfolders. It's just one way to do it - there are other, probably simpler ways, but it's what came to mind for me as I'm kind of used to digging in folders and recordsets recursively this way.

Another problem you had was your method of comparing dates. The format of the .DateCreated property comes in with date and time. You can directly compare this to the Now() function, which returns date and time - but if you try to compare to the Date() function it won't work because it's a different format.

I wasn't sure what you were trying to do with the file extension bit. I assumed you wanted to use it as a filter, so that's what I did with it.

A few notes: You currently are telling the user at the end that "you can find the files from " but you are not checking if that is true. You may want to add a check after the .Copy action and then add your results to an array or something so you can show the user a list of files that successfully copied and files that did not. When I was testing, I created the folders you had in my Users directory, and I got an error when trying to copy of not having the required permissions.

Right now the From path, To path, and extension filter are all hard-coded. If you plan to distribute this or will be using it yourself in multiple locations, you could use the BrowseForFolder method to present the user with a folder browser dialog and allow them to select the From and To folders. You could also use InputBox to get a filter from the user. Just a thought.

Anyways, here is what I did with your code. I changed the variable names to my naming convention simply because that is what I'm used to - you can change them however you want.

Option Explicit

Public Sub CopyPasteFiles()
    'Declare variables
        Dim SRfso                   As Scripting.FileSystemObject
        Dim strFrom                 As String
        Dim strTO                   As String
        Dim strExtFilter             As String
        Dim SRfolderA               As Scripting.Folder
        Dim SRfolderB               As Scripting.Folder

    'Are you always going to hardcode these or do you want to be able to browse for a folder?
        strFrom = "C:\Users\Run"  '<< Change
        strTO = "C:\Users\Test"    '<< Change

    'I'm not sure what your intent is with this - I assumed you wanted to filter by file extension.
        strExtFilter = "*BT.CSV"

    'Prep the folder path
        If Right(strFrom, 1) <> "\" Then
            strFrom = strFrom & "\"
        End If

    'Intialize the FileSystemObject
        Set SRfso = New Scripting.FileSystemObject

        'Verify input and output folders exist. Inform user if they don't.
            If SRfso.FolderExists(strFrom) = False Then
                MsgBox strFrom & " doesn't exist"
                Exit Sub
            End If

            If SRfso.FolderExists(strTO) = False Then
                MsgBox strTO & " doesn't exist"
                Exit Sub
            End If

    'Get the input folder using the FileSystemObject
        Set SRfolderA = SRfso.GetFolder(strFrom)

    'Call the routine that copies the files
        MoveTheFiles SRfolderIN:=SRfolderA, strFolderOUT:=strTO ', strExtFilter:=strExtFilter

    'Inform the user where they can find the files. CAUTION: You may be misinforming the user.
        MsgBox "You can find the files from " & strFrom & " in " & strTO

End Sub

Private Sub MoveTheFiles(ByRef SRfolderIN As Scripting.Folder, _
                            ByRef strFolderOUT As String, _
                            Optional ByRef strExtFilter As String = "*.*", _
                            Optional ByRef blnSUBFOLDERS As Boolean = True)
'This routine copies the files.  It requires two arguments.  First, it requires the root folder as folder object from the scripting library. _
 Second, it requires the output path as a string.  There are two optional arguments. The first allows you _
 to use a text filter as a string.  The second is a boolean that tells us whether or not to move files in subfolders - the default is true.

    'Delcare variables
        Dim SRfileA                 As Scripting.File
        Dim SRfolderCol             As Scripting.Folders
        Dim SRfolderA               As Scripting.Folder
        Dim datCreated              As Date
        Dim lngFX                   As Long
        Dim blnResult               As Boolean

    'Find the file extension in the filter
        lngFX = InStrRev(strExtFilter, ".", , vbTextCompare)

    'Move the files from the root folder
        For Each SRfileA In SRfolderIN.Files
            'Only work with files that contain the filter criteria
                If Ucase(Mid(SRfileA.Name, InStrRev(SRfileA.Name, ".", , vbTextCompare) - (Len(strExtFilter) - lngFX) + 1, Len(strExtFilter))) Like Ucase(strExtFilter) Then
                'Only work with files that were created within the last 100 days
                    datCreated = SRfileA.DateCreated
                        If datCreated <= Now And (datCreated >= DateAdd("d", -100, Now())) Then
                            SRfileA.Copy strFolderOUT
                        End If
                End If
        Next

    'Check if the calling procedure indicated we are supposed to move subfolder files as well
        If blnSUBFOLDERS Then
        'Check that we have subfolders to work with
            Set SRfolderCol = SRfolderIN.SubFolders
                If SRfolderCol.Count > 0 Then
                        For Each SRfolderA In SRfolderIN.SubFolders
                            MoveTheFiles SRfolderIN:=SRfolderA, strFolderOUT:=strFolderOUT, strExtFilter:=strExtFilter, blnSUBFOLDERS:=blnSUBFOLDERS
                        Next
                End If
        End If

End Sub