Run update if source file is more current than last used

[breynolds0431]

Hi. I currently have a file with a userform. The userform has fields that update based on an ID that's entered. The information associated with the entered ID is continually changing and sometimes there are new IDs established. So, what I have is a hidden tab with the ID data in the form's workbook. That tab has a cell with the date the data was last updated - this cell is named Updated. The source file to that data is a .xlsx file on a LAN location and is updated each evening. When the form is opened, the macro checks to see if Updated is today's date. If not, it will run the update process - which is a simple process of opening the source file and copying it's contents to the form's hidden tab of ID data. This works great, however, it appears that the ID data should be updated a couple to a few times daily to best serve its function. Any ideas on how the macro, on workbook open, could look to a specific path and a specific file and obtain the file save data (date/time)? Then compare to the last update file's save data (date/time)? I'm guessing the vba would need to set a timestamp of when the files are saved in order for such a comparison to happen.

Below is what I have so far with just the single daily update. Thanks for any help that can be extended!

Private Sub Workbook_Open()

wksBlank.Activate
wksProject.Visible = xlSheetVeryHidden
ThisWorkbook.Sheets("ProvLook").Visible = False

If wksProvLook.Range("Updated").Value = Date Then

    frmNewProject.Show

Else

    With Application
    
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

On Error Resume Next
    
    ThisWorkbook.Sheets("ProvLook").Visible = True
    
    wksProvLook.Select
    Range("A2").CurrentRegion.Select
    Selection.ClearContents

        Workbooks.Open Filename:= _
            "T:\HIT DR\TM\TMFileData.xlsx", ReadOnly:=True
            
        Columns("A:H").Select
        Selection.Copy
        ThisWorkbook.Activate
        wksProvLook.Activate
        Range("A1").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Application.Goto Reference:="Updated"
        ActiveCell.FormulaR1C1 = "=TODAY()"
        Range("Updated").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("A2").Select
        Workbooks("TMFileData.xlsx").Close savechanges:=False

    ThisWorkbook.Sheets("ProvLook").Visible = False

With Application
    
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
    
    frmNewProject.Show

End If

On Error GoTo 0

End Sub

 

[breynolds0431]

I think i've figured out a solution, included below for reference...

Private Sub Workbook_Open()

wksBlank.Activate
wksProject.Visible = xlSheetVeryHidden
ThisWorkbook.Sheets("ProvLook").Visible = False

If wksProvLook.Range("Updated").Value = Date Then

Dim NSource As Date, Current As Date

NSource = FileDateTime("T:\HIT DR\TM\TMFileData.xlsx") 'Set T:\ to actual location
Current = ThisWorkbook.Sheets("TMData").Range("Updated")

'Will run update if 5 minutes have passed between time of current file and time of previous

If DateDiff("n", NSource, Current) <> 5 Then

    With Application
    
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    On Error Resume Next
    
    ThisWorkbook.Sheets("ProvLook").Visible = True
    
    wksProvLook.Select
    Range("A2").CurrentRegion.Select
    Selection.ClearContents

        Workbooks.Open Filename:= _
            "T:\HIT DR\TM\TMFileData.xlsx", ReadOnly:=True 'Set T:\ to actual location
            
        Columns("A:H").Select
        Selection.Copy
        ThisWorkbook.Activate
        wksProvLook.Activate
        Range("A1").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Application.Goto Reference:="Updated"
        ActiveCell.FormulaR1C1 = "=NOW()"
        Range("Updated").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("A2").Select
        Workbooks("TMFileData.xlsx").Close savechanges:=False

    ThisWorkbook.Sheets("ProvLook").Visible = False
    
    frmNewProject.Show

Else

    frmNewProject.Show

With Application
    
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With

End If

On Error GoTo 0

End Sub