Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Read number portion of file name as Date

Status
Not open for further replies.

patriciaxxx

Programmer
Jan 30, 2012
277
GB
I have the following files in a folder. The number portion represents a date as ddmmyy. I need to read them in date order so that I can delete the oldest ones leaving the 2 newest.

TrackBkp120113.mdb
TrackBkp120210.mdb
TrackBkp120212.mdb
TrackBkp120811.mdb
TrackBkp050113.mdb
TrackBkp120910.mdb
TrackBkp120912.mdb


Here is my code in an MS Access module. The problem with my code is it works by reading the number portion as a number and not a Date which means the correct files are not deleted. I have tried using CDate and Format and DateSerial functions to create an expression without success.

Code:
[COLOR=#204A87]        strData = CurrentProject.Path & "\BackupData\TrackBkp120910.mdb"
        ' Get the name of its folder
        strDir = Left(strData, InStrRev(strData, "\BackupData"))
        ' Now find any existing backups - keep only three
        strBkp = Dir(strDir & "BackupData\TrackBkp*.mdb")
        Do While Len(strBkp) > 0
          intBkp = intBkp + 1
          If (strBkp < strLowBkp) Or (Len(strLowBkp) = 0) Then
            ' Save the name of the oldest backup found
            strLowBkp = strBkp
          End If
          ' Get the next file
          strBkp = Dir
        Loop
        ' If more than two backup files
        If intBkp > 2 Then
          ' Delete the oldest one
          Kill strDir & "BackupData\" & strLowBkp
        End If
[/color]
 
What about this changes ?
Code:
...
        Do While Len(strBkp) > 0
          intBkp = intBkp + 1
          [!]strYMD = Mid(strBkp,13,2) & Mid(strBkp,11,2) & Mid(strBkp,9,2)
          If (strYMD < strLowYMD)[/!] Or (Len(strLowBkp) = 0) Then
            ' Save the name of the oldest backup found
            strLowBkp = strBkp
            [!]strLowYMD = strYMD[/!]
          End If
          ' Get the next file
          strBkp = Dir
        Loop
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Hello PHV

Thanks for the reply. I’ve tested your changes which do transpose the numbers.

The problem now is the code on the KILL lines which still doesn’t kill the oldest file(s).

Code:
[COLOR=#204A87]        ' If more than two backup files
        If intBkp > 2 Then
          ' Delete the oldest one
          Kill strDir & "BackupData\" & strLowBkp
        End If
[/color]

 
Hello PHV,

Here is my actual code, it compiles without errors.

Code:
[COLOR=#204A87]Option Compare Database
Option Explicit

Private Function BackupDatabase()

Dim gstrAppTitle As String
gstrAppTitle = "MY_TITLE"
Dim intErr As Integer, frm As Form, intI As Integer
Dim strData As String, strDir As String
Dim lngOpen As Long, datBackup As Date
Dim strLowBkp As String, strBkp As String, intBkp As Integer
Dim db As DAO.Database, rst As DAO.Recordset
Dim strLowYMD As String, strYMD As String

  If vbNo = MsgBox("Are you sure you want to exit?", _
    vbYesNo + vbQuestion + vbDefaultButton2, _
      gstrAppTitle) Then
      Exit Function
  End If
  ' Skip backup check if there were errors
  If intErr = 0 Then
    Set db = CurrentDb
    ' Open tblBackupDatabase to see if we need to do a backup
    Set rst = db.OpenRecordset("tblBackupDatabase", dbOpenDynaset)
    rst.MoveFirst
    lngOpen = rst!OpenCount
    datBackup = rst!LastBackup
    rst.Close
    Set rst = Nothing
    ' If the user has opened 10 times
     ' or last backup was more than 2 weeks ago...
    If (lngOpen Mod 10 = 0) Or ((Date - datBackup) > 14) Then
      ' Ask if they want to backup...
      If vbYes = MsgBox("LawTrack highly recommends backing up " & _
        "your data to avoid " & _
        "any accidental data loss.  Would you like to backup now?", _
        vbYesNo + vbQuestion, gstrAppTitle) Then
        ' Get the name of the data file
        strData = Mid(db.TableDefs("tblBackupDatabase").Connect, 11)
        ' Get the name of its folder
        strDir = Left(strData, InStrRev(strData, "\BackupData"))
        ' See if the "BackupData" folder exists
        If Len(Dir(strDir & "BackupData", vbDirectory)) = 0 Then
          ' Nope, build it!
          MkDir CurrentProject.Path & "\BackupData"
        End If
        ' Now find any existing backups - keep only three
        strBkp = Dir(strDir & "BackupData\LawTrackBkp*.mdb")
        Do While Len(strBkp) > 0
          intBkp = intBkp + 1
          strYMD = Mid(strBkp, 16, 2) & Mid(strBkp, 14, 2) & Mid(strBkp, 12, 2)
          If (strYMD < strLowYMD) Or (Len(strLowBkp) = 0) Then
            ' Save the name of the oldest backup found
            strLowBkp = strBkp
            strLowYMD = strYMD
          End If
          ' Get the next file
          strBkp = Dir
        Loop
        ' If more than two backup files
        If intBkp > 2 Then
          ' Delete the oldest one
          Kill strDir & "BackupData\" & strLowBkp
        End If
        ' Now, setup new backup name based on today's date
        strBkp = strDir & "BackupData\LawTrackBkp" & _
          Format(Date, "ddmmyy") & ".mdb"
        ' Make sure the target file doesn't exist
        If Len(Dir(strBkp)) > 0 Then Kill strBkp
        ' Create the backup file using Compact
        DBEngine.CompactDatabase strData, strBkp
        ' Now update the backup date
        db.Execute "UPDATE tblBackupDatabase SET tblBackupDatabase.LastBackup = Date()", dbFailOnError
        MsgBox "Backup created successfully!", vbInformation, gstrAppTitle
      End If
    End If
    Set db = Nothing
  End If
  
frmMain_Exit:
  On Error GoTo 0
  
  ' In a production application, would quit here
  MsgBox "DONE"
  Exit Function
frmMain_Error:
  'ErrorLog "frmMain", Err, Error
  Resume frmMain_Exit

End Function[/color]
 
One tip, instead of using mmddyy I always use YYYYMMDD which can be expressed as a Long Integer which you can then easily sort in descending order in your code.
 
how about using the FileDateTime() function that is built into access?

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>
 
Thank you all for your comments.

Interesting FileDateTime() function, never new about that one, sure I’ll find a use for it somewhere.

Guess I’ll have to go year. month, day and get use to reading the file names like that.
 
>I always use YYYYMMDD

This is often known as the ISO 8601 basic calendar date format, and is correctly sortable both lexically and numerically

If the the process writing the files used ISO8601 for the date part of the name, then you could do a simple string sort without having to extract any numerical part at all ...
 
Yep. You can parse it out of text fields and filenames, and then sort the resulting long integers in an array or temp table, for this problem you'd sort DESC then select the top two values and you got it.
 
>You can parse it out of text fields and filenames

My point is that if the filenames only differ by the date part, and the date part is ISO 8601, you do not have to parse anything out. You can simply sort the filenames.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top