compact based name in table

[sal21]

I have a list of names of database access in a field of table:

field_path_database (text property)

\\sewrver1\dir2\database1.mdb
\\sewrver1\dir2\database5.mdb
\\sewrver1\dir2\database9.mdb

i need to loop each records and compat&repair the related databases.

How to in vba for Excel?

Note:
- the server pathname is the same from all databases
- check before the compact& repair if a database is just opned from other proess

[HansV]

Use Tools | References... to set a reference to the Microsoft DAO 3.6 Object Library.

Code: Select all

Sub CompactDatabases()
    Const TempName = "C:\Temp\TempDb1234567.mdb"
    Dim dbsList As DAO.Database
    Dim dbsOpen As DAO.Database
    Dim rstList As DAO.Recordset
    Set dbsList = DAO.DBEngine.OpenDatabase("C:\Access\MyDatabase.mdb")
    Set rstList = dbsList.OpenRecordset("tblDatabases", dbOpenForwardOnly)
    Do While Not rstList.EOF
        Set dbsOpen = Nothing
        Kill TempName
        On Error Resume Next
        Set dbsOpen = DBEngine.OpenDatabase(rstList(0), True)
        On Error GoTo 0
        If Not dbsOpen Is Nothing Then
            dbsOpen.Close
            DAO.DBEngine.CompactDatabase rstList(0), TempName
            If Dir(TempName) <> "" Then
                Kill rstList(0)
                Name TempName As rstList(0)
            End If
        End If
        rstList.MoveNext
    Loop
    rstList.Close
    dbsList.Close
End Sub

Change C:\Access\MyDatabase.mdb to the path and filename of the database that contains the list of database names, and tblDatabases to the name of the table containing that list. I have assumed that the list is in the first field of that table.

[sal21]

Use Tools | References... to set a reference to the Microsoft DAO 3.6 Object Library.

Code: Select all

Sub CompactDatabases()
    Const TempName = "C:\Temp\TempDb1234567.mdb"
    Dim dbsList As DAO.Database
    Dim dbsOpen As DAO.Database
    Dim rstList As DAO.Recordset
    Set dbsList = DAO.DBEngine.OpenDatabase("C:\Access\MyDatabase.mdb")
    Set rstList = dbsList.OpenRecordset("tblDatabases", dbOpenForwardOnly)
    Do While Not rstList.EOF
        Set dbsOpen = Nothing
        Kill TempName
        On Error Resume Next
        Set dbsOpen = DBEngine.OpenDatabase(rstList(0), True)
        On Error GoTo 0
        If Not dbsOpen Is Nothing Then
            dbsOpen.Close
            DAO.DBEngine.CompactDatabase rstList(0), TempName
            If Dir(TempName) <> "" Then
                Kill rstList(0)
                Name TempName As rstList(0)
            End If
        End If
        rstList.MoveNext
    Loop
    rstList.Close
    dbsList.Close
End Sub

Change C:\Access\MyDatabase.mdb to the path and filename of the database that contains the list of database names, and tblDatabases to the name of the table containing that list. I have assumed that the list is in the first field of that table.

TKS!
"GENIUS"

Note:
but i have "gogooling" and see, exists also a JRO metthod.
Based to speed up the operation wath is the best?

[HansV]

It probably won't make much difference.

[sal21]

It probably won't make much difference.

Tks.

[sal21]

It probably won't make much difference.

ok.
Now i have insert the sub in open workbook event and saved the wbook on a server dir.
Is possible to start the code in the workbook event each Tuesday and Thursday, automaticlly?

Other way are welcomed.
Tks.

[HansV]

Try this:

Code: Select all

Private Sub Workbook_Open()
    Dim dtmLast As Date
    On Error GoTo ErrHandler
    dtmLast = ThisWorkbook.CustomDocumentProperties("CompactDate")
    If dtmLast < Date Then
        If Weekday(Date) = vbTuesday Or Weekday(Date) = vbThursday Then
            Call CompactDatabases
            ThisWorkbook.CustomDocumentProperties("CompactDate") = Date
        End If
    End If
    Exit Sub
ErrHandler:
    If Err = 5 Then
        ThisWorkbook.CustomDocumentProperties.Add "CompactDate", False, _
            msoPropertyTypeDate, Date - 1
        Resume
    End If
End Sub

Save the workbook after the code has run.

[sal21]

Try this:

Code: Select all

Private Sub Workbook_Open()
    Dim dtmLast As Date
    On Error GoTo ErrHandler
    dtmLast = ThisWorkbook.CustomDocumentProperties("CompactDate")
    If dtmLast < Date Then
        If Weekday(Date) = vbTuesday Or Weekday(Date) = vbThursday Then
            Call CompactDatabases
            ThisWorkbook.CustomDocumentProperties("CompactDate") = Date
        End If
    End If
    Exit Sub
ErrHandler:
    If Err = 5 Then
        ThisWorkbook.CustomDocumentProperties.Add "CompactDate", False, _
            msoPropertyTypeDate, Date - 1
        Resume
    End If
End Sub

Save the workbook after the code has run.

OK...
but if i have understand the first activation of current code, run only tomorrow for the first one and it run automaticlly each Tuesday and Thursday, without the user run anything?

[HansV]

CompactDatabases will run the first time the workbook is opened on a Tuesday or Thursday.
So for example, if you open the workbook tomorrow morning, it will execute CompactDatabases, but not if you open it a second or third time tomorrow. It will not call CompactDatabases at all on Wednesday, but it will do so the first time you open the workbook on Thursday, etc.