'*******************************************************************************
' Project   : Generic
'
' Module    : basDatabaseInfo
' DateTime  : 1/17/2000 10:24
' Author    : Bill Mosca
' Purpose   : Look up database info
' References: DAO
' Index     :(Updated on 4/9/2008)
  ' SetProjTitle - Assigns global Project Title
  ' GetSummaryInfo - Get Summary info such as Title for current project
  ' GetUserDefinedInfo - Get UserDefined Database property values
  ' GetFileFormat - Get file format of another database.
'*******************************************************************************

Public gstrProjTitle As String


Public Sub ChangeProperty(db As DAO.Database, strPropertyName As String, _
        varPropertyType As Variant, varPropertyValue As Variant)

    On Error GoTo err_PROC

    db.Properties(strPropertyName) = varPropertyValue

exit_PROC:
    Exit Sub

err_PROC:
    'If property not found, create it.
    If Err = 3270 Then
        Dim prpNew As DAO.Property
        Set prpNew = db.CreateProperty(strPropertyName, varPropertyType, _
                varPropertyValue, True)
        db.Properties.Append prpNew
    Else
        MsgBox Err.Description, vbCritical
    End If

End Sub

Public Function GetFileFormat(strDBFullPath As String)
'Purpose  : Get file format of another database.
'DateTime : 7/16/2007 09:16
'Author   : Bill Mosca
    Dim AccApp As Access.Application
    Dim cnn As ADODB.Connection
    Dim strConn As String
    Dim strFormat As String
    
    Set AccApp = New Access.Application
    AccApp.OpenCurrentDatabase strDBFullPath
    
    Select Case AccApp.CurrentProject.FileFormat
        Case acFileFormatAccess2
            strFormat = "Access 2.0"
        Case acFileFormatAccess2000
            strFormat = "Access 2000"
        Case acFileFormatAccess2002
            strFormat = "Access XP"
        Case acFileFormatAccess95
            strFormat = "Access 95"
        Case acFileFormatAccess97
            strFormat = "Access 97"
    End Select

    GetFileFormat = strFormat
    AccApp.CloseCurrentDatabase
    Set AccApp = Nothing

End Function


Public Function GetSummaryInfo(strPropName As String, _
                               Optional IsAddin As Boolean = False, _
                               Optional strType As String = "Summary") As String
'Purpose  : Get Summary or Custom info such as Title for current project
'DateTime : 8/09/2010 11:41
'Author   : Bill Mosca
    Dim dbs As DAO.Database, cnt As DAO.Container
    Dim doc As DAO.Document, prp As DAO.Property
    Const conPropertyNotFound = 3270

    On Error GoTo err_PROC

    'If information belongs to an add-in, use the add-in's database.
    If IsAddin = True Then
        Set dbs = CodeDb
    Else: Set dbs = CurrentDb
    End If

    Set cnt = dbs.Containers!Databases
    Select Case strType
        Case "Summary"
            Set doc = cnt.Documents!SummaryInfo
        Case "Custom"
            Set doc = cnt.Documents!UserDefined
    End Select

    doc.Properties.Refresh
    GetSummaryInfo = doc.Properties(strPropName)

exit_PROC:
    Exit Function

err_PROC:
    GetSummaryInfo = ""
    Resume exit_PROC

End Function

Function GetUserDefinedInfo(strPropName As String, IsAddin As Boolean) As String
'Purpose  : Get UserDefined Database property values
'DateTime : 3/19/2000 11:55
'Author   : Bill Mosca
    Dim dbs As DAO.Database, cnt As DAO.Container
    Dim doc As DAO.Document, prp As DAO.Property
    Const conPropertyNotFound = 3270
    
On Error GoTo err_GetUserDefined
    
    'If information belongs to an add-in, use the add-in's database.
    If IsAddin = True Then
        Set dbs = CodeDb
    Else: Set dbs = CurrentDb
    End If
    
    Set cnt = dbs.Containers!Databases
    Set doc = cnt.Documents!UserDefined
    doc.Properties.Refresh
    Set prp = doc.Properties(strPropName)
    
    GetUserDefinedInfo = prp.Value

exit_GetUserDefinedInfo:
    On Error Resume Next
    Set prp = Nothing
    Set doc = Nothing
    Set cnt = Nothing
    Set dbs = Nothing
    Exit Function
    
err_GetUserDefined:
    If Err.Number = conPropertyNotFound Then
        MsgBox "UserDefined Property " & strPropName & " not found."
    Else
        MsgBox "Error " & Err.Number & " (" & Err.Description _
            & ") in procedure GetUserDefinedInfo of basUtilities"
    End If
    GetUserDefinedInfo = ""
    Resume exit_GetUserDefinedInfo
    
End Function



Public Function SetDB_Summ_Cust_Property(strDocType As String, strPropName As String, lngDataType As Long, _
                              varValue As Variant)
'Purpose  : Sets database property as seen in Database Properties
'           window.
'DateTime : 1/14/2013 13:47
'Author   : Bill Mosca
'Requires :
    Dim dbs As DAO.Database
    Dim cnt As DAO.Container
    Dim doc As DAO.Document

    On Error GoTo err_PROC

    Set dbs = CurrentDb
    Set cnt = dbs.Containers!Databases
    If strDocType = "Summary" Then
        Set doc = cnt.Documents!SummaryInfo
    Else: Set doc = cnt.Documents!UserDefined
    End If
    
    doc.Properties.Refresh
    doc.Properties(strPropName) = varValue

exit_PROC:
    On Error Resume Next
    Set doc = Nothing
    Set cnt = Nothing
    Set dbs = Nothing
    Exit Function

err_PROC:
    Select Case Err.Number
        Case 3270, 3367
            Dim prpNew As DAO.Property
            Set prpNew = doc.CreateProperty(strPropName, lngDataType, _
                                            varValue)
            doc.Properties.Append prpNew
        Case Else
            MsgBox Err.Number & ": " & Err.Description
    End Select

    Resume exit_PROC

End Function

Public Sub SetProjTitle()
'Purpose  : Assigns global Project Title
'DateTime : 3/13/2007 10:15
'Author   : Bill Mosca
'Requires : gstrProjTitle global variable.
    gstrProjTitle = GetSummaryInfo("Title")
    
End Sub