â™ Modify my code: Need to qualify FolderDialog selection

[Ray]

Hi -

The code below is used by several procedures within a Tool I'm
currently developing. The code works well, but during End-User
testing, a 'hole' has been discovered -- the user can select a folder
containing old data, which will continue to work because these old
files are the proper format. So, I'd like to add a 'quality check' of
sorts -- one thought would be to check the 'modified date' on the
first workbook in the folder and to throw a msgbox if it's more than
180 days older than the current date. it's only necessary to check
one workbook, as other workbooks in the folder will be from the same
month.

I'm not sure what the coding to do this looks like ...

Can you help? I've indicated below where I think this quality check
should go, but am certainly open to other ideas ..

Thanks very much for your time!

Regards, Ray


Sub PickPath()

Dim Flags As Long, DoCenter As Boolean, Preset As String, Base As
String

Flags = BIF_RETURNONLYFSDIRS
Flags = Flags + BIF_NEWDIALOGSTYLE

Preset = Sheet6.Range("F17").Value

'If Len(Preset) > 0 Then
If Len(Dir(Preset)) = 0 Then
Base = Preset
'End If
Else
Base = CurDir
End If

RetStr = GetDirectory(Base, Flags, DoCenter, "Please select a
location to import from ...")
If RetStr = "" Then
MsgBox "No path selected ... update cancelled!"
Exit Sub
End If

' Quality-check code here
' If modified-date < ( current-date - 180)
' Then msgbox "data too old"
' exit sub
' End if
' End of Quality-Check Code

Sheet6.Range("F17").Value = RetStr

End Sub

 

[Chip Pearson]

You can use the FileDateTime function to get the file's last
modification time (in the local time zone). E.g.,

Dim ModDate As Date
Dim FolderName As String
Dim FName As String

FolderName = "C:" '<<< get directory name
FName = Dir(FolderName & "\*.xls", vbNormal)
If FName <> vbNullString Then
FName = FolderName & "\" & FName
Else
Exit Sub
End If

ModDate = FileDateTime(FName)

If Now - ModDate >= 180 Then
Debug.Print FName, ModDate, "old"
Else
Debug.Print FName, ModDate, "ok"
End If


Cordially,
Chip Pearson
Microsoft Most Valuable Professional,
Excel, 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com

 

[Ray]

Thanks alot Chip .... a big time-saver!