Fiind the newest file

  • Thread starter jln via OfficeKB.com
  • Start date
J

jln via OfficeKB.com

I need to have code find and open the newest file. Here is what i have now
but it will just select any file with this name. I need it to find the newest
file with this neam.

FileName = Dir("Q:\FTP\as400\exports\production\inv" & Inv & "\" & Inv &
"_Liq_loss_Detail*.xls")
 
J

Joel

Sub newestfile()

Set fs = CreateObject("Scripting.FileSystemObject")

First = True
LatestDate = 0
LatestFile = ""
Do
If First = True Then
Filename = _
Dir("Q:\FTP\as400\exports\production\inv" & _
Inv & "\" & Inv & "_Liq_loss_Detail*.xls")
First = False
Else
Filename = Dir()
End If
If Filename <> "" Then
Set f = fs.GetFile(Filename)
NewDate = f.DateLastModified
If NewDate > LatestDate Then
LatestFile = Filename
LatestDate = NewDate
End If

End If
Loop While Filename <> ""
MsgBox ("the Latest file is " & LatestFile & _
"Modified on : " & LatestDate)
End Sub
 
J

jln via OfficeKB.com

Ok added your code but I dont see filename showing anything but null or "" do
i have something set wrong?


Sub liqe()
On Error GoTo Handler
Dim first As String
Dim LatestDate As String
Dim latestFile As String
Dim f As Object
Dim newdate As String

Dim fs As Object

Sheets("CHECKLIST").Select
Range("D3").Select
Inv = ActiveCell

Dim Current As String


Current = "LiqLoss" & Month(Date) - 1 & Year(Date)

Set fs = CreateObject("Scripting.FileSystemObject")

first = True
LatestDate = 0
latestFile = ""
Do
If first = True Then
FileName = _
Dir("Q:\FTP\as400\exports\production\inv" & _
Inv & "\" & Inv & "_Liq_loss_Detail*.xls")
first = False
Else
FileName = Dir()
End If
If FileName <> "" Then
Set f = fs.GetFile(FileName)
newdate = f.DateLastModified
If newdate > LatestDate Then
latestFile = FileName
LatestDate = newdate
End If

End If
Loop While FileName <> ""

Sheets.Add
ActiveSheet.Name = Current
Set CurWks = ActiveSheet 'or whatever you want it to be
Workbooks.Open FileName
'Else
Application.DisplayAlerts = False
'deletes the DQ tab if no file exist
' box = MsgBox("Does Not have any loans with Stop advance payments this
month", vbOKOnly, "Dq Payments")
Application.DisplayAlerts = True
'Exit Sub
'End If
Set myWkbk = ActiveWorkbook

myWkbk.Worksheets(1).UsedRange.Copy _
Destination:=CurWks.Range("a1")

myWkbk.Close savechanges:=False

'Error handler if there is a sheet already with the name DQ payments
Handler:

If Err.Number = 1004 Then
Application.DisplayAlerts = False
Sheets("DQ Payments").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Err.Clear
' GoTo 1
End If

End Sub
 
C

Chip Pearson

I found the following in my library of utility procs. It will return the
fully qualified name of the most recently used file in the folder specified
by DirPath and having an extension equal to Extension. Extension may be
either a simple string (e.g., "xls" for Excel 97/2003 workbooks) or it may
be an array of one or more extensions (e.g,. Array("xls","xlsm","xlsx") for
2007 and earlier workbooks). It will return vbNullString if no files
matching Extension are found in the DirPath folder or if there are no files
in DirPath.

Function MostRecentFileName(DirPath As String, Extension As Variant) As
String
Dim SaveDir As String
Dim FileName As String
Dim MostRecent As Double
Dim MostRecentFile As String
Dim CurrFileDate As Double
Dim Ext As String
Dim CurrFileExt As String
Dim N As Long
Dim Pos As Long
FileName = "C:\Book1.xlsm"
Pos = InStrRev(FileName, ".")
CurrFileExt = Mid(FileName, Pos + 1)


SaveDir = CurDir
On Error Resume Next
ChDrive DirPath
If Err.Number <> 0 Then
Debug.Print "Invalid Path: " & DirPath
Exit Function
End If
ChDir DirPath
If Err.Number <> 0 Then
Debug.Print "Invalid Path: " & DirPath
Exit Function
End If

FileName = Dir(DirPath & "\*.*")

Do Until FileName = vbNullString
FileName = DirPath & "\" & FileName
CurrFileDate = FileDateTime(FileName)
If CurrFileDate > MostRecent Then
Pos = InStrRev(FileName, ".")

If Pos > 0 Then

CurrFileExt = Mid(FileName, Pos + 1)

If IsArray(Extension) = True Then
For N = LBound(Extension) To UBound(Extension)
Ext = Extension(N)
If StrComp(Ext, CurrFileExt, vbTextCompare) = 0 Then
MostRecent = CurrFileDate
MostRecentFile = FileName
Exit For
End If
Next N
Else
If (StrComp(Extension, "*", vbBinaryCompare) = 0) Or _
(StrComp(Extension, vbNullString, vbBinaryCompare) =
0) Then
MostRecent = CurrFileDate
MostRecentFile = FileName
Else
If StrComp(CurrFileExt, Extension, vbTextCompare) =
0 Then
MostRecent = CurrFileDate
MostRecentFile = FileName
End If
End If
End If

End If
End If

FileName = Dir()
Loop

ChDrive SaveDir
ChDir SaveDir
MostRecentFileName = MostRecentFile
End Function

You can then call this function with code like

Sub AAA()
Dim FileName As String
Dim ModDate As Date
Dim FilePath As String
Dim Ext As Variant
FilePath = ""
Ext = "xls" ' <<< SIMPLE STRING EXTENSION
' OR
Ext = Array("xls", "xlsm", "xlsx") '<< ARRAY OF EXTENSIONS
FileName = MostRecentFileName(DirPath:=FilePath, Extension:=Ext)
If FileName = vbNullString Then
Debug.Print "No file found"
Else
ModDate = FileDateTime(FileName)
Debug.Print "File: " & FileName, "Modified: " & ModDate
End If
End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)
 
J

Joel

First you need to change the following
from:
Workbooks.Open FileName
to
Workbooks.Open FileName:=latestFile

I still think one file should of been opened even with the error. The error
above just wouldn't of opened the latest file.

I fully checked the code before I posted it and it worked perfectly. I
could not check out you filename or path. there are two possible reasons why
the code isn't working:
1) There a4e no files with your "DIR" qualifications
2) You are getting to an error and bypassing the code.

a) Did the code work before your added my code? My code should at least
return the same worksheet
b) Is the correct cell selected before your run the code? Inv is obtained
from the selected cell.

If my changed doesn't work, then you should step through the code using the
F8 key and attempted to isolate the problem. Also add a message box
from:
Dir("Q:\FTP\as400\exports\production\inv" & _
Inv & "\" & Inv & "_Liq_loss_Detail*.xls")
to:
msgbox("Q:\FTP\as400\exports\production\inv" & _
Inv & "\" & Inv & "_Liq_loss_Detail*.xls")
Dir("Q:\FTP\as400\exports\production\inv" & _
Inv & "\" & Inv & "_Liq_loss_Detail*.xls")
 
R

Rick Rothstein \(MVP - VB\)

This function should do what you want...

Function FindLatest(FileNamePath As String) As String
Dim FName As String
Dim FPath As String
FPath = Left$(FileNamePath, InStrRev(FileNamePath, "\"))
FName = Dir$(FileNamePath)
FindLatest = FPath & FName
Do While Len(FName)
If FileDateTime(FPath & FName) > FileDateTime(FindLatest) Then
FindLatest = FPath & FName
End If
FName = Dir$
Loop
End Function

Just pass in the filename using the wildcard symbols ? or * to stand for the
variable text within the name with its fully qualified path. For your
example, the function call would look like this...

FileName = FindLatest("Q:\FTP\as400\exports\production\inv" & _
Inv & "\" & Inv & "_Liq_loss_Detail*.xls")

Rick
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top