olegvolf
08-29-2016, 06:07 AM
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
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