openaccess/source/modules/optimizer.bas

Option Compare Database
Option Explicit

Public Function get_last_update_date(ByVal acType As Integer, ByVal name As String)
On Error GoTo err

    Select Case acType
    
        Case acTable
            
            get_last_update_date = DFirst("DateUpdate", "MSysObjects", "([Type]=1 or [Type]=4 or [Type]=6) and [name]='" & name & "'")
        
        Case acQuery
        
            get_last_update_date = DFirst("DateUpdate", "MSysObjects", "[Type]=5 and [name]='" & name & "'")
        
        Case acForm
            
            get_last_update_date = CurrentProject.AllForms(name).DateModified
        
        Case acReport
            
            get_last_update_date = CurrentProject.AllReports(name).DateModified
        
        Case acMacro
            
            get_last_update_date = CurrentProject.AllMacros(name).DateModified
        
        Case acModule
            
            get_last_update_date = CurrentProject.AllModules(name).DateModified
            
    End Select
    
    Exit Function
err:
    Debug.Print "get_last_update_date - erreur - " & acType & ", " & name & ": " & err.Description
    get_last_update_date = #1/1/1900#
End Function

Public Function list_modified(acType As Integer)
    Dim sources_date As Date
    
    list_modified = ""
    
    sources_date = get_sources_date()
    
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM MSysObjects WHERE " & typefilter(acType) & ";", _
                                     dbOpenSnapshot)
    If rs.RecordCount = 0 Then GoTo emptylist
    
    rs.MoveFirst
    
    Do Until rs.EOF
        If rs![dateupdate] > sources_date Then
            If Len(list_modified) > 0 Then
                list_modified = list_modified & ";" & rs![name]
            Else
                list_modified = rs![name]
            End If
        End If
        rs.MoveNext
    Loop

    Exit Function
emptylist:
End Function

Public Function msg_list_modified() As String
    Dim lstmod, obj_type_split, obj_type_label, obj_type_num As String
    Dim obj_type, objname As Variant
    
    msg_list_modified = ""

    For Each obj_type In Split( _
        "tables|" & acTable & "," & _
        "queries|" & acQuery & "," & _
        "forms|" & acForm & "," & _
        "reports|" & acReport & "," & _
        "macros|" & acMacro & "," & _
        "modules|" & acModule _
        , "," _
    )
        obj_type_split = Split(obj_type, "|")
        obj_type_label = obj_type_split(0)
        obj_type_num = obj_type_split(1)

        lstmod = list_modified(CInt(obj_type_num))
        
        If Len(lstmod) > 0 Then
            msg_list_modified = msg_list_modified & "** " & UCase(obj_type_label) & " **" & vbNewLine
            For Each objname In Split(lstmod, ";")
                msg_list_modified = msg_list_modified & "    " & objname & vbNewLine
            Next objname
        End If
    Next obj_type
    

End Function

Public Function is_dirty(acType As Integer, name As String)

    is_dirty = (get_last_update_date(acType, name) > get_sources_date)

End Function

Public Function get_sources_date() As Date

    get_sources_date = CDate(vcs_param("sources_date", "01/01/1900 00:00:00"))

End Function


Public Sub update_sources_date()

If Not vcs_tbl_exists() Then
    Call create_vcs_tbl
End If

Call update_vcs_param("sources_date", CStr(Now))

End Sub



'NB: types msys
'-32768 = Form
'-32766 = Macro
'-32764 = Report
'-32761 = Module
'-32758  Users
'-32757  Database Document
'-32756  Data Access Pages
'1   Table - Local Access Tables
'2   Access Object - Database
'3   Access Object - Containers
'4   Table - Linked ODBC Tables
'5   Queries
'6   Table - Linked Access Tables
'8   SubDataSheets

Private Function typefilter(acType) As String

    Select Case acType
        Case acTable
            typefilter = "([Type]=1 or [Type]=4 or [Type]=6)"
        Case acQuery
            typefilter = "[Type]=5"
        Case acForm
            typefilter = "[Type]=-32768"
        Case acReport
            typefilter = "[Type]=-32764"
        Case acModule
            typefilter = "[Type]=-32761"
        Case acMacro
            typefilter = "[Type]=-32766"
        Case Else
            GoTo typerror
    End Select

Exit Function
typerror:
    MsgBox "typerror:" & acType & " is not a valid object type"
    typefilter = ""
End Function