Get oldest file from the folder

[olegvolf]

Hello

I have a vba code that opens the last modified file from the folder:

Sub getfiles()Dim y As Long, count As Long
count = 0
y = InputBox("Please Enter the Units QTY")
oldworkbook = ThisWorkbook.Name
Set sh1 = Sheets("data")
Sheets("data").Range("A2:k5000").ClearContents
'With Application.FileDialog(msoFileDialogFolderPicker)
' .Show
' MyFolder = .SelectedItems(1)
' MyFolder = MyFolder


'End With
counter:


' --> User Settings
Const MyFolder = "C:\PROGRAMS\HP\CA442-91171_CTQ"

' Open GetOpenFilename with the file filters.


Const MyMask = "*.CSV" ' should be in upper case
' <-- End of User Settings

Dim f As String, d As Date, fd As Date, x


' On Error GoTo exit_
For Each x In CreateObject("Scripting.FileSystemObject").GetFolder(MyFolder).Files


If UCase(x.Name) Like MyMask Then
fd = x.DateLastModified

If d < fd Then
d = fd
f = x.Path
End If
End If
Next

Sheets("data").Select
Workbooks.OpenText Filename:= _
f, Origin _
:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, SPACE:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1))
Cells.Select
Cells.EntireColumn.AutoFit





txtworkbook = ActiveWorkbook.Name

Range("A1:K6500").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(oldworkbook).Activate
Range("A1").Select
ActiveSheet.Paste

Application.DisplayAlerts = False
Windows(txtworkbook).Activate
ActiveWindow.Close SaveChanges:=False
Application.DisplayAlerts = True

Windows(oldworkbook).Activate

Application.CutCopyMode = False


t = Sheets("data").Range("k65536").End(xlUp).Row
i = 1
Do Until InStr(sh1.Cells(i, 1), "Duration") > 0


If InStr(UCase(sh1.Cells(i, 1)), "PART") > 0 Then
sh1.Cells(i, 1).Copy _
Destination:=sh1.Cells(t - 2, 11)
If InStr(UCase(sh1.Cells(i, 1)), "LOT") > 0 Then
sh1.Cells(i, 1).Copy _
Destination:=sh1.Cells(t - 1, 11)
End If

End If
i = i + 1
Loop

'Move file for back up
Dim FromPath As String
Dim ToPath As String
FromPath = f '<< Change
ToPath = MyFolder & "\" & "Backup\" '<< Change only the destination folder

Set FSO = CreateObject("scripting.filesystemobject")
FSO.MoveFile Source:=FromPath, Destination:=ToPath



count = count + 1
d = d - 1
If count <> y Then GoTo counter






End Sub

I need some help in reversing the code to open the oldest file in the folder.

Thank you

[p45cal]

try changing:
If d < fd Then
to
If d > fd Then

Additionally, you can experiment with .DateCreated instead of .DatelastModified.

[olegvolf]

Hi Thanks

I tried but with no success.
when i do this :
If d > fd Then
it gives me ERROR

[Paul_Hossler]

Would you like to tell us the ERROR?

Post the updated macro also

[olegvolf]

Hello

I handled the error it because there was no files in the folder
but the updated code still pulls the latest file first instead of the oldest

Sub GETFILES()Dim y As Long, count As Long
count = 0
y = InputBox("Please Enter the Units QTY")
oldworkbook = ThisWorkbook.Name
Set sh1 = Sheets("data")
Sheets("data").Range("A2:k5000").ClearContents
'With Application.FileDialog(msoFileDialogFolderPicker)
' .Show
' MyFolder = .SelectedItems(1)
' MyFolder = MyFolder


'End With
counter:


' --> User Settings
Const MyFolder = "C:\PROGRAMS\HP\CA441-57600"

' Open GetOpenFilename with the file filters.


Const MyMask = "*.CSV" ' should be in upper case
' <-- End of User Settings

Dim f As String, d As Date, fd As Date, x


dateoldaest = Now
' On Error GoTo exit_
For Each x In CreateObject("Scripting.FileSystemObject").GetFolder(MyFolder).Files


If UCase(x.Name) Like MyMask Then
fd = x.DateCreated

If dateoldaest > fd Then
d = fd
f = x.Path
End If
End If
Next

Sheets("data").Select
Workbooks.OpenText Filename:= _
f, Origin _
:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, SPACE:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1))
Cells.Select
Cells.EntireColumn.AutoFit





txtworkbook = ActiveWorkbook.Name

Range("A1:K6500").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(oldworkbook).Activate
Range("A1").Select
ActiveSheet.Paste

Application.DisplayAlerts = False
Windows(txtworkbook).Activate
ActiveWindow.Close SaveChanges:=False
Application.DisplayAlerts = True

Windows(oldworkbook).Activate

Application.CutCopyMode = False


t = Sheets("data").Range("k65536").End(xlUp).Row
i = 1
Do Until InStr(sh1.Cells(i, 1), "Duration") > 0


If InStr(UCase(sh1.Cells(i, 1)), "PART") > 0 Then
sh1.Cells(i, 1).Copy _
Destination:=sh1.Cells(t - 2, 11)
If InStr(UCase(sh1.Cells(i, 1)), "LOT") > 0 Then
sh1.Cells(i, 1).Copy _
Destination:=sh1.Cells(t - 1, 11)
End If

End If
i = i + 1
Loop

'Move file for back up
Dim FromPath As String
Dim ToPath As String
FromPath = f '<< Change
ToPath = MyFolder & "\" & "Backup\" '<< Change only the destination folder

Set FSO = CreateObject("scripting.filesystemobject")
FSO.MoveFile Source:=FromPath, Destination:=ToPath



count = count + 1
d = d - 1
If count <> y Then GoTo counter






End Sub

[Aussiebear]

I think the following line is incorrect
"If dateoldaest > fd Then"

[p45cal]

since you've altered d to dateoldaest, you need to do it in other places too.

[Kenneth Hobs]

'Command line switches for the shell's Dir, http://ss64.com/nt/dir.html

Sub FileOldNew()
MsgBox Split(CreateObject("Wscript.Shell").Exec _
("cmd /c dir x:\csv\*.csv /o:d /a:-d /b").StdOut.ReadAll, vbLf)(0), _
vbInformation, "Oldest File"

MsgBox Split(CreateObject("Wscript.Shell").Exec _
("cmd /c dir x:\csv\*.csv /o:-d /a:-d /b").StdOut.ReadAll, vbLf)(0), _
vbInformation, "Newest File"
End Sub

[olegvolf]

Hi
Thanks
The code you wrote repaved all my code?

[snb]

Yes,

even this suffices:


Sub FileOldNew()
MsgBox Split(CreateObject("Wscript.Shell").Exec("cmd /c dir ""X:\csv\*.csv"" /od /a-d /b").StdOut.ReadAll, vbLf)(0), , "Oldest File"
End Sub

[olegvolf]

Thank you
If it not too hard can you please give some explanation on the code.

[Kenneth Hobs]

The WScript.Shell or Command Shell Dir method just addresses file creation dates. I believe. A few tests quickly shows how it works in the code of #8. Of course that method is also handy to just get the list of files and works well looking in subfolders. Once you have a list of filenames, an array could be created to hold the DateModified and other information. You can then use WorksheetFunction.Min or Max to get the value. A WorkSheetFunction.Match can then be used to get the index of the array element. Once you know the index, you can get the filename.

FSO as you did should work fine for your modified date.

Recently, I used a Shell.Application method to get just a filtered list of files by one or more filters. e.g. "*.doc,*.docx".
I find that method better than the VBA Dir and Command Shell Dir methods for simple one folder file searches.

[olegvolf]

Many thanks
I just cannot succeed to put your code into mine and what should i replace
I am sorry for so many questions

[Kenneth Hobs]

Dir is a command shell command. It is <> VBA's Dir. To get help for that command to see what command line switches it has, see the link that I provided. You can also get similar help for each command. e.g. Win+R > cmd > help dir > exit.

Just replace MsgBox with f= and remove the two end parameters of MsgBox and use your path. e.g.

Sub Ken()
Dim f As String
f = Split(CreateObject("Wscript.Shell").Exec _
("cmd /c dir C:\PROGRAMS\HP\CA441-57600\*.csv /o:d /a:-d /b").StdOut.ReadAll, vbLf)(0)
'.. other stuff
Workbooks.OpenText Filename:= _
f, Origin _
:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1))
End Sub

[snb]

I fear.... the path won't be found.


Sub M_snb()
workbooks.open Split(CreateObject("Wscript.Shell").Exec("cmd /c dir ""C:\PROGRAMS\HP\CA441-57600\*.csv"" /od /s /b").StdOut.ReadAll, vbCrLf)(0)
End Sub