Print

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright (C) 2004-2012 AGORA Software BV, http://www.helpgenerator.com/, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Option Compare Database

Private Const mcstrModuleName As String = "basHtmlHelp"

' HTML HELP singleton object running in the same thread as the host application
Private mobjHTMLHelp As CHTMLHelp

Public Property Get HTMLHelp() As CHTMLHelp
' Get HTML Help signleton object instance - custom class clsHtmlHelp
If mobjHTMLHelp Is Nothing Then
Set mobjHTMLHelp = New CHTMLHelp
End If
Set HTMLHelp = mobjHTMLHelp
End Property

Public Function HelpFileFullPath(ByVal vstrHelpFileNameOrFullPath As String) As String
If Len(vstrHelpFileNameOrFullPath) = 0 Then
vstrHelpFileNameOrFullPath = rObjectPropertyUserDefinedGet("HelpFile")
End If

If (InStr(vstrHelpFileNameOrFullPath, "\") > 0 Or InStr(vstrHelpFileNameOrFullPath, "/") > 0) Then
HelpFileFullPath = vstrHelpFileNameOrFullPath
Else
HelpFileFullPath = AppPath() & vstrHelpFileNameOrFullPath
End If
End Function

Public Function AppPath() As String
AppPath = Application.CurrentProject.Path & "\"
End Function

Private Function rObjectPropertyUserDefinedGet(ByVal vstrPrpName As String) As String
' Get User defined property of a database
On Error GoTo HandleErr
Dim strPropName As String
Dim dbs As DAO.Database
Dim cnt As DAO.Container
Dim doc As DAO.Document
Dim prp As DAO.Property

strPropName = vstrPrpName
Set dbs = Application.CurrentDb
Set cnt = dbs.Containers!Databases ' Define Container object.
Set doc = cnt.Documents!UserDefined ' Define Document object.
doc.Properties.Refresh
Set prp = doc.Properties(strPropName)
rObjectPropertyUserDefinedGet = prp.Value
HandleExit:
Exit Function
HandleErr:
rObjectPropertyUserDefinedGet = ""
Resume HandleExit
End Function