PDA

View Full Version : [SOLVED] Modified Move Files from one hard drive to another vba



Shazam
09-15-2005, 06:58 PM
Hey everybody!

Well I got this code from your website. It tansfers files from one hard drive to another. Can it be modified to transfer all files except the recent file that it was saved to that folder ? If that can be done I would like another code that it will transfer all files except the last 2 recent files that was saved to that folder.

Thanks!



Option Explicit
Option Compare Text
Sub MoveFiles()
Dim myFile As String
Dim oldName As String
Dim newName As String
Dim FileType As String
oldName = "C:\August\" 'This is the original folder
newName = "D:\Test" 'This is the new folder - will be created with the MkDir Statement
FileType = "xls" 'Enter File Type to be moved
'e.g. xls, xl*, doc, do*, or * for all files
On Error Resume Next
MkDir newName 'create a new folder based on the path for the variable 'newName'
myFile = Dir(oldName & "\*." & FileType) 'not restricted to xls files, could also be Word documents etc
Do Until myFile = "" 'until there are no files left
Name oldName & "\" & myFile As newName & "\" & myFile
myFile = Dir 'calls Dir Function again without changing the Path
Loop
End Sub

geekgirlau
09-15-2005, 08:54 PM
This will move all but the most recent file


Option Explicit
Option Compare Text

Sub MoveFiles()
' Purpose: Move all files from one folder to another EXCLUDING the
' most recently saved file
' Restrictions: Requires reference to Microsoft Scripting Runtime
Dim FS As FileSystemObject
Dim objFolder As Folder
Dim objFile As File
Dim strOldFolder As String
Dim strNewFolder As String
Dim strFileType As String
Dim strRecentFile As String
Dim dtmRecent As Date
strOldFolder = "C:\August\"
strNewFolder = "D:\Test"
' must match the "Type" property of the file object
strFileType = "Microsoft Excel Worksheet"
On Error Resume Next
MkDir strNewFolder
On Error GoTo ErrHandler
' use file system object to loop through files
Set FS = CreateObject("Scripting.FileSystemObject")
Set objFolder = FS.GetFolder(strOldFolder)
' find the most recent file
For Each objFile In objFolder.Files
' only want certain file types
If objFile.Type = strFileType Then
' is this the most recent file?
If objFile.DateLastModified > dtmRecent Then
dtmRecent = objFile.DateLastModified
strRecentFile = objFile.Name
End If
End If
Next objFile
' move all files except most recent
For Each objFile In objFolder.Files
If objFile.Type = strFileType Then
If objFile.Name <> strRecentFile Then
objFile.Move strNewFolder
End If
End If
Next objFile
ExitHere:
On Error Resume Next
Set objFile = Nothing
Set objFolder = Nothing
Set FS = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Number & ": " & Err.Description
Resume ExitHere
End Sub



When you're talking about leaving the 2 most recent files, it gets a lot more complicated. Basically you would have to fill an array and sort the array by dates - it can be done, but it gets tricky.

Shazam
09-16-2005, 04:44 AM
Thank You it works perfectly!:bow:

geekgirlau
09-16-2005, 04:29 PM
You're welcome - don't forget to mark the thread as solved.

Shazam
09-17-2005, 09:59 AM
Once again thank You fo your help!

gibbo1715
09-19-2005, 03:41 AM
Option Compare Text

Can someone explain the purpose of this command to me please

Cheers

Gibbo

sandam
09-19-2005, 03:56 AM
Option Compare Text


When using string comparators, if you select option compare text then when the function is doing the comparison (wether it be a StrComp or an InStr) it ignores case in the strings. If you use binary compare, the comparison is case sensitive.

Bob Phillips
09-19-2005, 06:40 AM
Can someone explain the purpose of this command to me please

To quote help

Option Compare Text results in string comparisons based on a case-insensitive text sort order determined by your system's locale (javascript:hhobj_9.Click()). When the same characters are sorted using Option Compare Text, the following text sort order is produced:

(A=a) < ( ?=?) < (B=b) < (E=e) < (?=?) < (Z=z) < (?=?)

gibbo1715
09-19-2005, 08:10 AM
Thankyou