Need to open access database on server without updating VB

Hi LookUpAnswer,

  dim xdb as database
  set xdb = dbengine.opendatabase(strDBName)

regards,
-jadedata-

I'm not sure how to use this information

The VB code  (with no registry update) uses the string variables later in functions

I.e.


Dim strDBName As String
strDBName = "C:\Documents and Settings\smith\Desktop\database 1.mdb"
...

Call RunUpdates(strDBName)

>>>>>>>>>>>>>>>>>

So I added a registry key -- RefLibPaths and added the value name of 'database 1.mdb' with a  value data of "C:\Documents and Settings\smith\Desktop\database 1.mdb"

but I don't know how to change my VB code to reference it..

If I add as you suggested

dim xdb as database
  set xdb = dbengine.opendatabase(strDBName)

what should I set strDBName to?

Dim strDBName As String

strDBName = ??

How should I update the function calls?

Would they become Call RunUpdates(xdb)?

Thanks for you help -- if I've gone down the wrong path with the registry and there's a better way to deal with opening the database on multiple machines (i.e. with variable paths) without requiring a code change -- please let me know.

Thanks

You could store the value in the Registry, or in an INI file ... or a simple text file. Personally, I'd use the registry for this, then get the value from the registry. Access includes the GetSetting adn SAveSetting functions, but they are extremely limited in their scope and may not provide what you're looking for. The code at the end of this posting will help with that.

So, let's say you store the value here:

HKeyLocalMachine\SOFTWARE\<Company_or_Developer_Name>\<AppName>

in a Key named "DBPath", you put this: "C:\Documents and Settings\smith\Desktop\database 1.mdb"

Your code would look like this:

Dim strDBName As String
strDBName = REgRead("SOFTWARE\Infotrakker\ProjectManager", "DBPath", HKLM)

You would of course have to change the values and Registry path above to "point" to the correct section of the registry.

As always, when dealing with the registry, be VERY careful ... don't muck around too much with it until you're very confident of what you're doing, since a little slip can cause devastating consequences. What you're doing here is pretty standard, but don't stray too far until you've got some experience under your belt with this.

Copy and paste the entire code block below in a Standard Module ... this is what you use to read/write to the registry

'//////// CODE START

  Option Compare Database
  Option Explicit

  'Attribute VB_Name = "modRegistry"
  ' modRegistry.Bas - Declares, Subroutines and Functions for the Registry
  ' 1997/05/03 Copyright 1994-1997, Larry Rebich, The Bridge, Inc.
  '
  ' Functions and Subroutines included in this module:
  '
  '   Function RegRead    Returns a value using the Supplied Key and Value Name
  '   Function RegWrite   Write a value using the Supplied Key, Value Name and Value
  '                       Remove the Value Name if value is null [""]
  '   Function RegCreate  Create a Key, open the Key, then close the Key.
  '                       This function is called by RegWrite if the key does not exist.
  '                       There should be no reason to call this function directly.
  '
  ' Only string data [REG_SZ] is process by these routines.
  '
  ' For details see the comments associated with each function.
  '
   
  DefLng A-Z

  Public Const REG_SZ         As Long = 1
  Public Const REG_DWORD      As Long = 4
   
  Public Const HKEY_CLASSES_ROOT = &H80000000
  Public Const HKEY_CURRENT_USER = &H80000001
  Public Const HKEY_LOCAL_MACHINE = &H80000002
  Public Const HKEY_USERS = &H80000003
  '/these are just shortened constants ...
  Public Const HKCR = &H80000000
  Public Const HKCU = &H80000001
  Public Const HKLM = &H80000002
  Public Const HKU = &H80000003
 
  Public Const ERROR_NONE = 0
  Public Const ERROR_BADDB = 1
  Public Const ERROR_BADKEY = 2
  Public Const ERROR_CANTOPEN = 3
  Public Const ERROR_CANTREAD = 4
  Public Const ERROR_CANTWRITE = 5
  Public Const ERROR_OUTOFMEMORY = 6
  Public Const ERROR_ARENA_TRASHED = 7
  Public Const ERROR_ACCESS_DENIED = 8
  Public Const ERROR_INVALID_PARAMETERS = 87
  Public Const ERROR_NO_MORE_ITEMS = 259
  Const ERROR_FILE_NOT_FOUND& = 2
 
  Public Const ERROR_SUCCESS& = 0
  Public Const NO_ERROR& = 0
  Const KEY_QUERY_VALUE = &H1&
  Const KEY_SET_VALUE = &H2&
  Const KEY_CREATE_SUB_KEY = &H4&
  Const KEY_ENUMERATE_SUB_KEYS = &H8&
  Const KEY_NOTIFY = &H10&
  Const READ_CONTROL = &H20000
  Const SYNCHRONIZE = &H100000
  Const STANDARD_RIGHTS_READ = READ_CONTROL
  Const STANDARD_RIGHTS_WRITE = READ_CONTROL
  Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
  Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
  Const REG_OPTION_NON_VOLATILE = 0&
  Public Const REG_CREATED_NEW_KEY& = 1
  Public Const REG_OPENED_EXISTING_KEY& = 2

    Private Type FILETIME
      dwLowDateTime           As Long
      dwHighDateTime          As Long
    End Type

  '

    Private Type SECURITY_ATTRIBUTES
      nLength                 As Long
      lpSecurityDescription   As Long   'SECURITY_DESCRIPTOR
      bInheritHandle          As Boolean
    End Type

  Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

  Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
  ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
  lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, _
  lpdwDisposition As Long) As Long

  Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
  (ByVal hKey As Long, ByVal lpValueName As String) As Long

  Private Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" _
  (ByVal hKey As Long, ByVal lpValueName As String, phkResult As Long) As Long

  Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal ulOptions As Long, _
  ByVal samDesired As Long, phkResult As Long) As Long

  Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, lpReserved As Long, _
  lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

  Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
  ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

  ' End of Declarations ----------------------------------------------------------------
   
Private Function RegCreate(sKey As String, Optional lngHKey As Long) As Long
'/Purpose:
'/Created: 11/24/2004 07:50 AM
'/Created By: Scott

  '/Purpose:
  '/Created: 11/6/2003 10:56 PM
  '/Created By: Scott
  ' Create a key
  ' Returns:
  '    False if Fails to Create the Key
  ' or lDisposition:
  '    REG_CREATED_NEW_KEY& = 1& or   'created a new key
  '    REG_OPENED_EXISTING_KEY& = 2&  'key already exists
  '

  Dim lRtn                      As Integer
  Dim lHKey                     As Long           'return handle to opened key
  Dim lDisposition              As Long    'disposition
  Dim lpSecurityAttributes      As SECURITY_ATTRIBUTES

On Error GoTo Err_RegCreate
  If lngHKey <> 0 Then
    lRtn = RegCreateKeyEx(lngHKey, sKey, 0&, "", REG_OPTION_NON_VOLATILE, KEY_WRITE, _
      lpSecurityAttributes, lHKey, lDisposition)
  Else
    lRtn = RegCreateKeyEx(HKEY_CURRENT_USER, sKey, 0&, "", _
      REG_OPTION_NON_VOLATILE, KEY_WRITE, lpSecurityAttributes, lHKey, lDisposition)
  End If
 
    If lRtn = ERROR_SUCCESS Then
      RegCreate = lDisposition    'tell 'em if it existed or was created
      lRtn = RegCloseKey(lHKey)   'close the Registry
    End If 'If lRtn = ERROR_SUCCESS

Exit_RegCreate:
  On Error Resume Next
  Exit Function

Err_RegCreate:
  Select Case Err
    'case
    Case Else
     MsgBox Err & ":" & Error$, vbCritical, "basReg" & ": " & "RegCreate"
  End Select
 
  Resume Exit_RegCreate

End Function

Public Function RegRead(sKey As String, sValueName As String, Optional vntOptionalHKey As Variant) As String
  '/Purpose:
  '/Created: 11/6/2003 10:56 PM
  '/Created By: Scott
  ' Returns the Value found for this Key and ValueName
  ' Input:        Sample:
  '   sKey        "Software\Microsoft\File Manager\Settings"
  '   sValueName  "Face"
  ' Return:
  '               "FixedSys" or
  '               "" [null] if not found
  '-----------------------------------------------------------------------------------
  ' 96/09/18 Add support for different root level key. Needed to find DAO3032.DLL in class registry. Larry.

  Dim lOptionalHKey             As Long   '96/09/18 Can open a different area key.
  Dim lKeyType                  As Long
  Dim lHKey                     As Long       'return handle to opened key
  Dim lpcbData                  As Long    'length of data in returned string
  Dim sReturnedString           As String   'returned string value
  Dim sTemp                     As String     'temp string
  Dim lRtn                      As Long        'success or not success
   
On Error GoTo Err_RegRead
    If IsMissing(vntOptionalHKey) Then
      lOptionalHKey = HKEY_CURRENT_USER   'Use current user
    Else
      lOptionalHKey = vntOptionalHKey     'Use the one supplied
    End If 'If IsMissing(vntOptionalHKey)

  lKeyType = REG_SZ       'data type is string
  lRtn = RegOpenKeyEx(lOptionalHKey, sKey, 0&, KEY_READ, lHKey)

    If lRtn = ERROR_SUCCESS Then
      lpcbData = 1024                     'get this many characters
      sReturnedString = Space$(lpcbData)  'setup the buffer
      lRtn = RegQueryValueEx(lHKey, sValueName, ByVal 0&, lKeyType, sReturnedString, lpcbData)

        If lRtn = ERROR_SUCCESS Then
          sTemp = Left$(sReturnedString, lpcbData - 1)
        End If 'If lRtn = ERROR_SUCCESS

      RegCloseKey lHKey
    End If 'If lRtn = ERROR_SUCCESS

  RegRead = sTemp

Exit_RegRead:
  On Error Resume Next
  Exit Function

Err_RegRead:
  Select Case Err
    'case
    Case Else
     MsgBox Err & ":" & Error$, vbCritical, "basReg" & ": " & "RegRead"
  End Select
 
  Resume Exit_RegRead

End Function

Public Function RegWrite(sKey As String, sValueName As String, ByVal sValue As String, Optional vntOptionalHKey As Variant) As Integer
'/Purpose:
'/Created: 11/24/2004 07:51 AM
'/Created By: Scott

  '/Purpose:
  '/Created: 11/6/2003 10:56 PM
  '/Created By: Scott
  ' Input:        Sample:
  '   sKey        "Software\Microsoft\File Manager\Settings"
  '   sValueName  "Face"
  '   sValue      "FixedSys"
  ' Return:
  '   True if successful
  '
  ' If the current setting is the same as the new setting then the update is bypassed.
  '
  ' Note: If sValue = "" then sValueName is removed [deleted].
  '-----------------------------------------------------------------------------------

  Dim lOptionalHKey             As Long   '10/14/96 Can open a different area key(to register fonts). Boris
  Dim lRtn                      As Long
  Dim lKeyType                  As Long 'returns the key type.  This function expects REG_SZ
  Dim lHKey                     As Long 'return handle to opened key
  Dim iSuccessCount             As Integer

On Error GoTo Err_RegWrite
  lKeyType = REG_SZ       'these routines support only string types

    If IsMissing(vntOptionalHKey) Then
      lOptionalHKey = HKEY_CURRENT_USER   'Use current user
    Else
      lOptionalHKey = vntOptionalHKey     'Use the one supplied
    End If 'If IsMissing(vntOptionalHKey)
   
    If Trim$(sValue) <> "" Then             'if there is a value then update it
RegWriteTryAgain:
      lRtn = RegOpenKeyEx(lOptionalHKey, sKey, 0&, KEY_SET_VALUE, lHKey)  'open the Registry for update

        If lRtn = ERROR_SUCCESS Then
          lRtn = RegSetValueEx(lHKey, sValueName, 0&, lKeyType, ByVal sValue, CLng(Len(sValue) + 1))   'update the value

            If lRtn = ERROR_SUCCESS Then
              iSuccessCount = iSuccessCount + 1
            End If 'If lRtn = ERROR_SUCCESS

          lRtn = RegCloseKey(lHKey)       'close the Registry
        ElseIf lRtn = ERROR_FILE_NOT_FOUND Or lRtn = ERROR_BADKEY Then 'create it

            If RegCreate(sKey, lOptionalHKey) Then        'Create it, was it successful?
              GoTo RegWriteTryAgain       'Yes, go try writing again
            End If 'If RegCreate(sKey)

        End If 'If lRtn = ERROR_SUCCESS

    Else                                    'Value is null, delete the key
      lRtn = RegOpenKeyEx(lOptionalHKey, sKey, 0&, KEY_SET_VALUE, lHKey)  'open the Registry for update

        If lRtn = ERROR_SUCCESS Then
          lRtn = RegDeleteValue(lHKey, sValueName)

            If lRtn = ERROR_SUCCESS Then
              iSuccessCount = iSuccessCount + 1
            End If 'If lRtn = ERROR_SUCCESS

          lRtn = RegCloseKey(lHKey)       'close the Registry
        End If 'If lRtn = ERROR_SUCCESS

    End If 'If Trim$(sValue) <> ""

    If iSuccessCount > 0 Then
      RegWrite = True                     'OK, changed
    End If 'If iSuccessCount > 0

Exit_RegWrite:
  On Error Resume Next
  Exit Function

Err_RegWrite:
  Select Case Err
    'case
    Case Else
     MsgBox Err & ":" & Error$, vbCritical, "basReg" & ": " & "RegWrite"
  End Select
 
  Resume Exit_RegWrite

End Function

'////////////// CODE END

Note that if you want user to be able to grab this value from a remote machine, you can't use this code ... this would only work on the local workstation. If you'd rather put something on a mapped drive or server for all users to "look" at, you'd probably be better off with an INI file. You can use the code below (again, copy/paste to a standard module) and call it like this:

dim strDB As String
strDB = GetINI("//Server1/MyDirectory/DBSettings.ini","MyDb", "Path")

Assuming you have an INI file named DBSettings that looks like this:

[MyDb]
Path=C:\SomeDir\MyDB.mdb

you'll be able to retrieve it ...


"??????????? Code Start

  Option Compare Database
  Option Explicit

  Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  Declare Function WritePrivateProfileString Lib "kernel32.dll" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Long

Function WriteINI(iniFileName As String, INISection As String, INISetting As String, ValueToWrite As String) As Boolean
'/Purpose:
'/Created: 10/10/2004 07:25 AM
'/Created By: Scott

  Dim RetVal      As Long

On Error GoTo Err_WriteINI
  RetVal = WritePrivateProfileString(INISection, INISetting, ValueToWrite, iniFileName)


Exit_WriteINI:
  On Error Resume Next
  Exit Function

Err_WriteINI:
  Select Case Err
    'case
    Case Else
     MsgBox Err & ":" & Error$, vbCritical, "basINIRoutines" & ": " & "WriteINI"
  End Select
 
  Resume Exit_WriteINI
End Function

Function GetINI(iniFileName As String, INISection As String, INISetting As String) As String
'/Purpose:
'/Created: 10/10/2004 07:26 AM
'/Created By: Scott

  Dim mvarData       As String  ' receives the value read from the INI file
  Dim lngLength      As Long  ' receives length of the returned string

On Error GoTo Err_GetINI
  mvarData = Space(255)  ' provide enough room for the function to put the value into the buffer
  ' Read from the INI file
  lngLength = GetPrivateProfileString(INISection, INISetting, "none", mvarData, 255, iniFileName)
  mvarData = Left(mvarData, lngLength)  ' extract the returned string from the buffer
  GetINI = mvarData


Exit_GetINI:
  On Error Resume Next
  Exit Function

Err_GetINI:
  Select Case Err
    'case
    Case Else
     MsgBox Err & ":" & Error$, vbCritical, "basINIRoutines" & ": " & "GetINI"
  End Select
 
  Resume Exit_GetINI
End Function

are you making your UI with Access or VB?

if you can deal with the default location of the built-in registry functions you will use a lot less code :-)

Delete program settings. DeleteSetting
Read program settings.   GetSetting, GetAllSettings
Save program settings.   SaveSetting

Steve

Thanks Pete -- Currentproject.Fullname did the trick.