Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 82
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 236
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 82
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Latest Taxation Books available at jain book depot LATEST BOOKRELEASES JACK ANDERSON Excel Worksheet Functions 0 May 29th 10 01:25 PM
Find latest file in folder & Open Les Excel Programming 2 March 26th 08 07:01 AM
Move Files from Folder to Folder THE_RAMONES Excel Programming 2 May 25th 06 09:23 PM
Find folder with next to latest date Ed[_18_] Excel Programming 2 July 28th 04 08:51 PM
Move them to different folder Prasad Vanka Excel Programming 2 May 21st 04 01:50 PM


All times are GMT +1. The time now is 01:10 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"