• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

filtering folder for "date modified" date

Z

zohaib

Member
Hello All,

I have pasted my comments below inside the code. I do not want to copy all files rather the "date modified" I select.

Code: 
Sub sbCopyingAllExcelFiles()

Dim FSO
Dim sFolder As String
Dim dFolder As String
Dim oFolder As String

sFolder = "C:\Users\tmhzka\Desktop\New folder"
dFolder = "C:\Users\tmhzka\Desktop\morning"older path
oFolder = "C:\Users\tmhzka\Desktop\morning\del"
Set FSO = CreateObject("Scripting.FileSystemObject")

If Not FSO.FolderExists(dFolder) Then
MsgBox "Source Folder Not Found", vbInformation, "Source Not Found!"
ElseIf Not FSO.FolderExists(oFolder) Then
MsgBox "Destination Folder Not Found", vbInformation, "Destination Not Found!"
Else
FSO.movefile (dFolder & "\*.*"), oFolder
MsgBox "Successfully Copied All Excel Files to Destination", vbInformation, "Done!"
End If

If Not FSO.FolderExists(sFolder) Then
MsgBox "Source Folder Not Found", vbInformation, "Source Not Found!"
ElseIf Not FSO.FolderExists(dFolder) Then
MsgBox "Destination Folder Not Found", vbInformation, "Destination Not Found!"
Else


'i want to be able to select a date modified instead of copying everything over to the folder.


FSO.CopyFile (sFolder & "\*.*"), dFolder
MsgBox "Successfully Copied All Excel Files to Destination", vbInformation, "Done!"
End If

End Sub
 
If date is fixed then, you can directly use to same to loop/filter.

or are u looking to select each xl individually?
 
Hello Deepak

The date is not fixed. The folder contains a huge number of files and I want excel to ask me date and use that to filter the folders date modified column and copy those files only.

Thanks
Zohaib
 
For file operations requiring date filter etc, I tend to use FileDialog.
It gives ability to set filter as needed before you select files. Adds bit of manual process, but users often find it easier to understand.

upload_2016-4-15_8-54-3.png
 
Basically you need to loop through selection from FileDialog to perform your operation.

To move file(s) using FileDialog you can do something like below.

Code: 
Sub test()
Dim fd As FileDialog
Dim FilePicked As Integer, i As Integer

Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "your initial folder path"
fd.AllowMultiSelect = True
FilePicked = fd.Show

If FilePicked = 0 Then
    Exit Sub
End If

For i = 1 To fd.SelectedItems.Count
    Name fd.SelectedItems(i) As "your destination folder" & "file name"
Next i

End Sub

It may be easier for you to work with Deepak's suggested method.
 
Chihiro,

Your code did not work for some reason? I found below code online. But it gives me error @ line "FSO.SelectedItems.CopyFile (sFolder & "\*.*"), dFolder" ?

Code: 
'In this Example I am Coping all excel files from one Folder ("C:\Temp\") to another Folder ("D:\Job\")
Sub sbCopyingAllExcelFiles()

Dim FSO
Dim sFolder As String
Dim dFolder As String
Dim oFolder As String

sFolder = "C:\Users\tmhzka\Desktop\New folder" ' change to match the source folder path
dFolder = "C:\Users\tmhzka\Desktop\morning" ' change to match the destination folder path
oFolder = "C:\Users\tmhzka\Desktop\morning\del" ' old files
Set FSO = CreateObject("Scripting.FileSystemObject")

If Not FSO.FolderExists(dFolder) Then
MsgBox "Source Folder Not Found", vbInformation, "Source Not Found!"
ElseIf Not FSO.FolderExists(oFolder) Then
MsgBox "Destination Folder Not Found", vbInformation, "Destination Not Found!"
Else
FSO.movefile (dFolder & "\*.*"), oFolder
MsgBox "Successfully Copied All Excel Files to Destination", vbInformation, "Done!"
End If

If Not FSO.FolderExists(sFolder) Then
MsgBox "Source Folder Not Found", vbInformation, "Source Not Found!"
ElseIf Not FSO.FolderExists(dFolder) Then
MsgBox "Destination Folder Not Found", vbInformation, "Destination Not Found!"
Else



    'Declare a variable as a FileDialog object.
    Dim fd As FileDialog

    'Create a FileDialog object as a File Picker dialog box.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant

    'Use a With...End With block to reference the FileDialog object.
    With fd

        'Use the Show method to display the File Picker dialog box and return the user's action.
        'The user pressed the action button.
        If .Show = -1 Then

            'Step through each string in the FileDialogSelectedItems collection.
            For Each vrtSelectedItem In .SelectedItems

                'vrtSelectedItem is a String that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example simply displays the path in a message box.
                FSO.SelectedItems.CopyFile (sFolder & "\*.*"), dFolder
              
                'MsgBox "The path is: " & vrtSelectedItem

            Next vrtSelectedItem
        'The user pressed Cancel.
        Else
        End If
    End With

    'Set the object variable to Nothing.
    Set fd = Nothing






'MsgBox "Successfully Copied All Excel Files to Destination", vbInformation, "Done!"
End If

End Sub
 
Hmm? Working fine on my end.

Added portion to make filename dynamic (retains same file name when moved to new folder).
Code: 
Sub test()
Dim fd As FileDialog
Dim FilePicked As Integer, i As Integer
Dim fname As String, dest As String
Dim x As Variant

Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "your initial folder path"
fd.AllowMultiSelect = True
FilePicked = fd.Show

If FilePicked = 0 Then
    Exit Sub
End If

For i = 1 To fd.SelectedItems.Count
    x = Split(fd.SelectedItems(i), "\", , vbTextCompare)
    fname = Trim(x(UBound(x)))
    dest = "C:\Test\" & fname ' change C:\Test\ with your destination folder
    Name fd.SelectedItems(i) As dest
Next i

End Sub
 
Oh then change "Name" to "FileCopy".

Code: 
Name fd.SelectedItems(i) As dest

To
Code: 
FileCopy fd.SelectedItems(i), dest
 
You must log in or register to reply here.
Back
Top