Solved: moving files greater than 1mg

[obriensj]

Hi,

I
I have got my hands on the below code for moving files and works great.
However I would like to add to it, so I can move files but only those files greater than 1 mg in size?
I have tried playing around with FileItem.Size and adding this in the if statement but cant seem to work.
Can anyone help please?
Oh yeh one slight niggle with existing code: When it does move the files it seems to ignore those files in subfolder,
For instance FromPath = "H:\Steve ETF files\New Company
There maybe one or more subfolders here, I would like files in these folders to be moved as well?




Sub Copy_Files_Dates()
'This example copy all files between certain dates from FromPath to ToPath.
'You can also use this to copy the files from the last ? days
'If Fdate >= Date - 30 Then
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Fdate As Date
Dim FileInFromFolder As Object


FromPath = "H:\Steve ETF files\New Company" '<< Change
ToPath = "H:\Steve ETF files\Move test" '<< Change
If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If
If Right(ToPath, 1) <> "\" Then
ToPath = ToPath & "\"
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 FileInFromFolder In FSO.GetFolder(FromPath).Files
Fdate = Int(FileInFromFolder.DateLastModified)

'Copy files from 1-Oct-2006 to 1-Nov-2006
If Fdate <= DateSerial(2008, 12, 31) Then
FileInFromFolder.Move ToPath

End If
Next FileInFromFolder


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

[Bob Phillips]

[vba]

Sub Copy_Files_Dates()
'This example copy all files between certain dates from FromPath to ToPath.
'You can also use this to copy the files from the last ? days
'If Fdate >= Date - 30 Then
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Fdate As Date
Dim FileInFromFolder As Object

FromPath = "H:\Steve ETF files\New Company" '<< Change
ToPath = "H:\Steve ETF files\Move test" '<< Change
If Right(FromPath, 1) <> "\" Then FromPath = FromPath & "\"
If Right(ToPath, 1) <> "\" Then ToPath = ToPath & "\"

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 FileInFromFolder In FSO.GetFolder(FromPath).Files

If FileInFromFolder.Size >= 1000000 Then

Fdate = Int(FileInFromFolder.DateLastModified)

'Copy files from 1-Oct-2006 to 1-Nov-2006
If Fdate <= DateSerial(2008, 12, 31) Then
FileInFromFolder.Move ToPath
End If
End If
Next FileInFromFolder

MsgBox "You can find the files from " & FromPath & " in " & ToPath
End Sub
[/vba]

[obriensj]

Thanks xld this works.
However just one problem, it does not move files greater than 1 mg in the subfolders.
It just looks at the main folder: H:\Steve ETF files\New Company
Any ideas?

Thanks

[Bob Phillips]

You want subfolders?

[vba]

Sub Cotrol()
'This example copy all files between certain dates from FromPath to ToPath.
'You can also use this to copy the files from the last ? days
'If Fdate >= Date - 30 Then
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String

FromPath = "H:\Steve ETF files\New Company" '<< Change
ToPath = "H:\Steve ETF files\Move test" '<< Change
If Right(FromPath, 1) <> "\" Then FromPath = FromPath & "\"
If Right(ToPath, 1) <> "\" Then ToPath = ToPath & "\"

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

Call Copy_Files_Dates(FSO, FromPath, ToPath)

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

End Sub

Private Sub Copy_Files_Dates(FSO As Object, FromPath As String, ToPath As String)
Dim Fdate As Date
Dim FileInFromFolder As Object
Dim folder As Object
Dim subFolder As Object

Set folder = FSO.GetFolder(FromPath)
For Each FileInFromFolder In folder.Files

If FileInFromFolder.Size >= 1000000 Then

Fdate = Int(FileInFromFolder.DateLastModified)

'Copy files from 1-Oct-2006 to 1-Nov-2006
If Fdate <= DateSerial(2008, 12, 31) Then
FileInFromFolder.Move ToPath
End If
End If
Next FileInFromFolder

For Each subFolder In folder.subfolders

Call Copy_Files_Dates(FSO, subFolder.Path, ToPath)
Next subFolder
End Sub
[/vba]

[obriensj]

That is great xld, appreciated!