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 Wanet Telecoms Ltd on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Compact a directory of Access 97 databases? 1

Status
Not open for further replies.

jlodge

Programmer
Aug 6, 2001
3
US
I'm in a large organization and am working on the conversion of Access 97 mdb's to Version 2003. In an effort to not use ALL of the free network space, I first want to grab copies of the mdb's, place them in a conversion directory and compact them right away. (Using MS Access 97).

Most of the mdb's have been created by end users who know nothing about the compact function so these may be pretty bloated. Has anyone written some code that would go through a directory and compact all mdb's within it?
 
Here's some simple stuff using DAO. You can switch to ADO if that's more to your liking.
Code:
Private Sub CompactEm(ThePath As String)
    Dim dbname      As String
    Dim FCErr       As ErrObject
    Dim FL_Before   As Long
    Dim FL_After    As Long
    Dim FSO         As New FileSystemObject

    dbname = Dir(ThePath & "*.mdb")
    Do Until dbname = ""
        FL_Before = FileLen(ThePath & dbname)
        Set FCErr = FixDataBase(ThePath, dbname)
        FL_After = FileLen(ThePath & dbname)
        dbname = Dir()
    Loop

End Sub

Private Function FixDataBase(Path As String, _
                             DataBaseName As String) As ErrObject

    Dim ErrNum          As Long
    Dim db              As DAO.Database
    Dim SaveName        As String

    On Error Resume Next
    Me.MousePointer = vbHourglass
    Set FixDataBase = Err
    Err.Clear
    SaveName = "TempCompact.mdb"
    DAO.DBEngine.CompactDatabase Path & DataBaseName, Path & SaveName
    If Err.Number = 0 Then
        ' Rename it after compacting
        Kill Path & DataBaseName
        Name Path & SaveName As Path & DataBaseName
    End If
    Set FixDataBase = Err

    ' Close the database (just in case it was opened.)
    Set db = Nothing
    Me.MousePointer = vbDefault

End Function
You may need to add some code to handle errors returned by the "FixDataBase" function.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top