Check for newer file with date

phaques

New Member
Joined
Oct 18, 2005
Messages
5
Howdy!

I'm looking for some direction on how to write code that will check for a newer file. The file format is like this: "NewFile - 11-16-2005.xls". Within my programming already is the update file method that saves changes to the newer date in the filename (NewFile - 11-17-2005.xls).
What I am trying to accomplish is when a person opens an older file, it checks for a newer version and let's the user know this, perhaps even open it for them after a few prompts.
Is this achievable?

Thanks for any and all assistance!
 

Some videos you may like

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
I think this is what you want. As set it checks the folder that the workbook containing the macro is in. Commenting the line indicated will check the current active folder.
Code:
Sub OPEN_LAST_FILENAME()
    Dim MyPath As String
    Dim CheckFile As String
    Dim FileDate As String
    Dim FileFilter As String
    Dim CheckDate As Date
    Dim LastDate As Date
    Dim LastFile As String
    '------------------------
    LastFile = " No file matches criteria"
    FileFilter = "*??-??-????.xls"
    LastDate = #1/1/01#  ' initialise variable low value
    MyPath = ThisWorkbook.Path & "\" ' path as this workbook
    '- filter filenames including dates with correct format
    CheckFile = Dir(MyPath & FileFilter)
    '- LOOP
    Do While CheckFile <> ""
        If CheckFile <> "." And CheckFile <> ".." Then
            FileDate = Left(CheckFile, Len(CheckFile) - 4) 'remove .xls
            FileDate = Right(FileDate, 8)   ' get file date string
            CheckDate = FileDate            ' convert to date
            If CheckDate > LastDate Then
                LastDate = CheckDate
                LastFile = CheckFile
            End If
        End If
        CheckFile = Dir    ' Get next entry.
    Loop
    '---------------------------------------------------------------
    '- finish
    rsp = MsgBox("Open file ?   : " _
        & LastFile, vbYesNo, "NEWEST FILE")
    On Error GoTo GetOut
    If rsp = vbYes Then
        Workbooks.Open FileName:=LastFile
    End If
GetOut:
End Sub
 

phaques

New Member
Joined
Oct 18, 2005
Messages
5
Thanks for the head start! I cleaned this up a little and added my changes to it. Works like a charm!

Code:
Sub OPEN_LAST_FILENAME()
    Dim MyPath As String
    Dim CheckFile As String
    Dim FileDate As String
    Dim FileFilter As String
    Dim CheckDate As Date
    Dim LastDate As Date
    Dim LastFile As String
    '------------------------
    LastFile = " No file matches criteria"
    FileFilter = "* - ??-??-????.xls"
    LastDate = #1/1/2001#
    MyPath = ThisWorkbook.Path & "\"
    MyFile = ThisWorkbook.Name
    CheckFile = Dir(MyPath & FileFilter)
    Do While CheckFile <> ""
        If CheckFile <> "." And CheckFile <> ".." Then
            FileDate = Left(CheckFile, Len(CheckFile) - 6) 'remove .xls
            FileDate = Right(FileDate, 8)   ' get file date string
            CheckDate = FileDate            ' convert to date
            If CheckDate > LastDate Then
                LastDate = CheckDate
                LastFile = CheckFile
            End If
        End If
        CheckFile = Dir    ' Get next entry.
    Loop
    If LastFile = MyFile Then
    GoTo GetOut
    Else
    rsp = MsgBox("There is a newer version of this file available." & Chr(13) & LastFile & Chr(13) & "Would you like to open it?", vbYesNo, "NEWEST FILE")
    If rsp = vbYes Then
        Workbooks.Open Filename:=LastFile
        Workbooks(MyFile).Close SaveChanges:=False
    End If
    End If
GetOut:
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,118,286
Messages
5,571,313
Members
412,382
Latest member
Langtn02
Top