openaccess/source/modules/VCS_Utilities.bas

Option Compare Database

Public Function vcs_tbl_exists()
' return True if the 'ztbl_vcs' table exists
On Error GoTo err
    vcs_tbl_exists = (CurrentDb.TableDefs("ztbl_vcs").name = "ztbl_vcs")
Exit Function
err:
    If err.number = 3265 Then
        vcs_tbl_exists = False
    Else
        MsgBox "Error: " & err.Description, vbCritical
    End If
End Function


Public Function update_vcs_param(ByVal key As String, ByVal val As String)
' create or update the parameter in ztbl_vcs

    If Not vcs_tbl_exists() Then
        Call create_vcs_tbl
    End If

    If DCount("key", "ztbl_vcs", "[key]='" & key & "'") = 1 Then
        CurrentDb.execute "UPDATE ztbl_vcs SET ztbl_vcs.val = '" & val & "' " & _
                            "WHERE (((ztbl_vcs.key)='" & key & "'));"
    Else
        CurrentDb.execute "INSERT INTO ztbl_vcs ( val, [key] ) " & _
                           "SELECT '" & val & "' AS Expr1, '" & key & "' AS Expr2;"
    End If

End Function

Public Function create_vcs_tbl()
'creates the 'ztbl_vcs' table and hide it
    CurrentDb.execute "SELECT 'include_tables' as key, 'ztbl_vcs' as val INTO ztbl_vcs;"
    Application.SetHiddenAttribute acTable, "ztbl_vcs", True
End Function

Public Function IsInArray(ByVal stringToBeFound As String, ByRef arr As Variant) As Boolean
' returns True if the string is in the array
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

Public Function msys_type_filter(acType) As String
'returns a sql filter string for the object type
'NB: do not return system tables
'NB2: here are the types in msysobjects table:
'-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

    Select Case acType
        Case acTable
            msys_type_filter = "(([Type]=1 or [Type]=4 or [Type]=6) AND ([name] Not Like 'MSys*' AND [name] Not Like 'f_*_Data'))"
        Case acQuery
            msys_type_filter = "[Type]=5"
        Case acForm
            msys_type_filter = "[Type]=-32768"
        Case acReport
            msys_type_filter = "[Type]=-32764"
        Case acModule
            msys_type_filter = "[Type]=-32761"
        Case acMacro
            msys_type_filter = "[Type]=-32766"
        Case Else
            GoTo typerror
    End Select

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

Public Function remove_ext(ByVal filename As String) As String
    ' removes the extension of a file name
    If Not InStr(filename, ".") > 0 Then
        remove_ext = filename
        Exit Function
    End If

    Dim splitted_name As Variant
    splitted_name = Split(filename, ".")

    Dim i As Integer
    remove_ext = ""
    For i = 0 To (UBound(Split(filename, ".")) - 1)
        If Len(remove_ext) > 0 Then remove_ext = remove_ext & "."
        remove_ext = remove_ext & Split(filename, ".")(i)
    Next i

End Function