Thursday, September 8, 2016

Using ADO to get path to BackEnd table

Option Compare Database
Option Explicit

#Const DEBUG_MODE = 1
#Const PROD_MODE = 0
#Const APP_MODE = DEBUG_MODE

Private Const msMODULE As String = "modMain"


Function getAppPath() As String
Const ssource As String = "getAppPath"
On Error GoTo ErrorHandler

'Dim objCatalog As Object    'ADOX.Catalog
'Dim objTable As Object      'ADOX.Table

'Set objCatalog = CreateObject("ADOX.Catalog")
'Set objCatalog = New ADOX.Catalog
'Set objCatalog.ActiveConnection = CurrentProject.Connection

'Set objTable = New ADOX.Table
''Set objTable = CreateObject("ADOX.Table")
'objTable.Name = "DailyWork"
'Set objTable.ParentCatalog = objCatalog
'Set objTable = objCatalog.Tables("DailyWork")
'getAppPath = JustPathfromFileName(objTable.Properties("Jet OLEDB:Link DataSource"))
getAppPath = Application.TempVars("AppPath").Value
ExitProc:
    On Error Resume Next
    'Set objCatalog = Nothing
    'Set objTable = Nothing
    Exit Function

ErrorHandler:
   
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function
Public Sub StartUp()
'will rename to init globals
'will read from INI file to get path for executable
Dim objCatalog As Object    'ADOX.Catalog
Dim objTable As Object      'ADOX.Table
Dim strAppPath As String
On Error Resume Next


Set objCatalog = CreateObject("ADOX.Catalog")
'Set objCatalog = New ADOX.Catalog
Set objCatalog.ActiveConnection = CurrentProject.Connection

'Set objTable = New ADOX.Table
Set objTable = CreateObject("ADOX.Table")
objTable.Name = "DailyWork"
Set objTable.ParentCatalog = objCatalog
Set objTable = objCatalog.Tables("DailyWork")
strAppPath = JustPathfromFileName(objTable.Properties("Jet OLEDB:Link DataSource"))
Application.TempVars.Add "AppPath", strAppPath
gbApp_SetupOccurred = True

'getAppPath()
'Call SetErrorFilePath(CurrentProject.Path) 'log errors here

Call SetErrorFilePath(strAppPath) 'log errors here

gbDEBUG_MODE = Len(Dir$(AddBS(CurrentProject.Path) & "debug.ini")) > 0

'gsREG_APP=
'APP_NAME = "CPLI App"

End Sub

Public Sub SetErrorFilePath(strPath As String)
'test if folder exists
If Len(strPath) = 0 Then Exit Sub
If Right$(strPath, 1) = "\" Then strPath = Left(strPath, Len(Trim(strPath)) - 1)
gstrERROR_LOG_PATH = strPath
End Sub

No comments: