Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Move all except latest to another folder
Hi,
I found the following code posted by Ron Debruin to delete all files except most recent within a folder. What I'd like to do is to move all except the most recent excel file from the current folder to the archives folder leaving the most recent excel file. There may be more file types than excel within the current folder. Function NewestFile(Directory, FileSpec) ' John Walkenbach ' http://www.j-walk.com/ss/excel/tips/tip97.htm ' Returns the name of the most recent file in a Directory ' That matches the FileSpec (e.g., "*.xls"). ' Returns an empty string if the directory does not exist or ' it contains no matching files Dim FileName As String Dim MostRecentFile As String Dim MostRecentDate As Date If Right(Directory, 1) < "\" Then Directory = Directory & "\" FileName = Dir(Directory & FileSpec, 0) If FileName < "" Then MostRecentFile = FileName MostRecentDate = FileDateTime(Directory & FileName) Do While FileName < "" If FileDateTime(Directory & FileName) MostRecentDate Then MostRecentFile = FileName MostRecentDate = FileDateTime(Directory & FileName) End If FileName = Dir Loop End If NewestFile = MostRecentFile End Function Sub Kill_All_Old_Files_in_Folder() Dim Folder As String Dim str1 As String Dim str2 As String Folder = "c:\Data\" str1 = NewestFile(Folder, "*.xls") str2 = Folder & str1 If str1 < "" Then Name str2 As Left(str2, Len(str2) - 4) & ".rdb" On Error Resume Next Kill Folder & "*.xls" On Error GoTo 0 Name Left(str2, Len(str2) - 4) & ".rdb" As str2 End If End Sub Thanks in advance for your help. -- By persisting in your path, though you forfeit the little, you gain the great. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Move all except latest to another folder
If your question is how to move the files instead of deleting them
then try method 'Name' in vba help. Note that it's METHOD and not a PROPERTY. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Move all except latest to another folder
Thanks AB for your response. I did lookup create names, list names and apply
names methods. i finally developed additional modications to the one I previously posted. It seems to work for me. please see below. Option Explicit Function NewestFile(Directory, FileSpec) ' John Walkenbach ' http://www.j-walk.com/ss/excel/tips/tip97.htm ' Returns the name of the most recent file in a Directory ' That matches the FileSpec (e.g., "*.xls"). ' Returns an empty string if the directory does not exist or ' it contains no matching files Dim FileName As String Dim MostRecentFile As String Dim MostRecentDate As Date If Right(Directory, 1) < "\" Then Directory = Directory & "\" FileName = Dir(Directory & FileSpec, 0) If FileName < "" Then MostRecentFile = FileName MostRecentDate = FileDateTime(Directory & FileName) Do While FileName < "" If FileDateTime(Directory & FileName) MostRecentDate Then MostRecentFile = FileName MostRecentDate = FileDateTime(Directory & FileName) End If FileName = Dir Loop End If NewestFile = MostRecentFile End Function Sub Move_All_Old_Files_in_Folder() Dim Folder As String Dim str1 As String Dim str2 As String Folder = "J:\Test\Current" str1 = NewestFile(Folder, "*.xls") str2 = Folder & str1 If str1 < "" Then Name str2 As Left(str2, Len(str2) - 4) & ".rdb" On Error Resume Next MoveOldiesToArchives On Error GoTo 0 Name Left(str2, Len(str2) - 4) & ".rdb" As str2 End If End Sub Sub MoveOldiesToArchives() Dim FSO Dim sfol As String, dfol As String sfol = "J:\Test\Current" ' change to match the source folder path dfol = "J:\Test\Archives" ' change to match the destination folder path Set FSO = CreateObject("Scripting.FileSystemObject") On Error Resume Next If Not FSO.FolderExists(sfol) Then MsgBox sfol & " is not a valid folder/path.", vbInformation, "Invalid Source"" ElseIf Not fso.FolderExists(dfol) Then" MsgBox dfol & " is not a valid folder/path.", vbInformation, "Invalid Destination """ Else FSO.MoveFile (sfol & "\*.xls"), dfol ' Change "\*.*" to "\*.xls" to move Excel Files only End If If Err.Number = 53 Then MsgBox "File not found" End Sub Thanks again for your response. -- By persisting in your path, though you forfeit the little, you gain the great. "AB" wrote: If your question is how to move the files instead of deleting them then try method 'Name' in vba help. Note that it's METHOD and not a PROPERTY. . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Latest Taxation Books available at jain book depot LATEST BOOKRELEASES | Excel Worksheet Functions | |||
Find latest file in folder & Open | Excel Programming | |||
Move Files from Folder to Folder | Excel Programming | |||
Find folder with next to latest date | Excel Programming | |||
Move them to different folder | Excel Programming |