Read Directory Content and perform action 1

[rgbanse]

Ok, here's the setup. I have a directory C:\MyDatabases\.
Within that directory are multiple databases.
At system startup, each database is copied and has a Version Stamp (DateTime) appended to it ie: DatabaseName_Ver0701010501.mdb.

C:\MyDatabases\ dir
DatabaseName001.mdb
DatabaseName001_Ver0627010501.mdb
DatabaseName001_Ver0628010501.mdb
DatabaseName001_Ver0629010501.mdb
DatabaseName002.mdb
DatabaseName002_Ver0627010501.mdb
DatabaseName002_Ver0628010501.mdb
DatabaseName003.mdb
DatabaseName003_Ver0627010501.md

I guess you get the idea.

I will always want to copy the master database, but I would like to keep a maximum of three(3) copies. So here's what I
want to do. I want to scan the directory for the number of version copies for each master DB and if the max count is reached I would delete the oldest copy based on the Version Stamp.

Thanks in advance.
Sorry for being so verbose.
RGB

 

[Aivars]

Hi RGB!

Try to use following function for saving of DB copy:

Call NewDB_Version("C:\MyDatabases\", "DatabaseName002","0501&quot

Function NewDB_Version(MyDBDir As String, DB_CurrentVersion As String, Optional SaveVersion As String = "&quot
Dim i As Long
Dim DB_Name As String
Dim DB_NewVersion As String

MyDBDir = "C:\MyDatabases\"
If Dir(MyDBDir, vbDirectory) = "" Then
MsgBox "No directory '" & MyDBDir & "' on disk!"
GoTo Exit_DBver
End If
'Check for existing file with same name as new version
DB_CurrentVersion = MyDBDir & DB_CurrentVersion & ".mdb" 'DB name
DB_NewVersion = MyDBDir & DB_CurrentVersion & "_Ver" & _
CStr(Format(Date, "mmddyy&quot) & SaveVersion & ".mdb" 'New version name
If Dir(DB_NewVersion) <> &quot;&quot; Then
If MsgBox(DB_NewVersion & &quot; already exist. Do you want to replace it?&quot;, vbYesNo + vbQuestion + vbDefaultButton2, &quot;DB copy&quot = vbNo Then
GoTo Exit_DBver
End If
Kill DB_NewVersion
End If

DB_Name = DB_CurrentVersion & &quot;_Ver*&quot; & SaveVersion & &quot;.mdb&quot; 'Files like
'Searching of files
With Application.FileSearch
.LookIn = MyDBDir
.FileName = DB_Name
.SearchSubFolders = False
If .Execute(msoSortByLastModified, msoSortOrderDescending) > 3 Then
'Remove old files with earlier modify date
For i = 4 To .FoundFiles.Count
Kill .FoundFiles(i)
Next i
End If
End With
DBEngine.CompactDatabase DB_CurrentVersion, DB_NewVersion

Exit_DBver:
Exit Function

End Function

Good luck!
Aivars

 

[rgbanse]

Aivars,
Thanks for the code. I modified it a bit,
and it works as desired.
Again thanks.
RGB