Ora_Techie
asked on
Create SYSTEM DSN Programatically if Exist then Overwrite the Existing Path
Hi Experts
I want to Create a SYSTEM DSN at RunTime
This would be in Sub Main or suggest me some better way
i want to take the Database path at runtime through
App.Path & "\" & "\Database\MyDb.Mdb"
Now i want a Function to Check and create DSN like this
NewDSNName = Abc
NewDSNPath = App.Path & Database
If NewDSNName = Any Existing Odbc DSN Name then
IF NewDSNPath = Current odbc DSN Path then
exit function
else
Over Write Same Available DSN Path = NewDSNPath
endif
else
Create a Fresh New DSN
endif
Please provide solution for both Acces & Sql server
I want to Create a SYSTEM DSN at RunTime
This would be in Sub Main or suggest me some better way
i want to take the Database path at runtime through
App.Path & "\" & "\Database\MyDb.Mdb"
Now i want a Function to Check and create DSN like this
NewDSNName = Abc
NewDSNPath = App.Path & Database
If NewDSNName = Any Existing Odbc DSN Name then
IF NewDSNPath = Current odbc DSN Path then
exit function
else
Over Write Same Available DSN Path = NewDSNPath
endif
else
Create a Fresh New DSN
endif
Please provide solution for both Acces & Sql server
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
You may need to integrate the above code with the Registry APIs, which allow you to read and write into Registry. Just wait couple of minutes, i will do a mock example for you..
cheers ;-)
cheers ;-)
Try this example, which customize from above example:
Option Explicit
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" _
(ByVal hwndParent As Long, ByVal fRequest As Long, _
ByVal lpszDriver As String, ByVal lpszAttributes As String) _
As Long
Private Const ODBC_ADD_SYS_DSN = 4
Public Function CreateSQLServerDSN(DSNName As String, _
ServerName As String, Database As String) As Boolean
'PURPOSE: 'CREATES A SYSTEM DSN FOR AN SQL SERVER DATABASE
'PARAMETERS: 'DSNName = DSN Name
'ServerName = Name of Server
'Database = Database to Use
'RETURNS: True if successful, false otherwise
'EXAMPLE: CreateSQLServerDSN "MyDSN", "MyServer", "MyDatabase"
Dim sAttributes As String
sAttributes = "DSN=" & DSNName & Chr(0)
sAttributes = sAttributes & "Server=" & ServerName & Chr(0)
sAttributes = sAttributes & "Database=" & Database & Chr(0)
CreateSQLServerDSN = CreateDSN("SQL Server", sAttributes)
End Function
Public Function CreateAccessDSN(DSNName As String, _
DatabaseFullPath As String) As Boolean
'PURPOSE: 'CREATES A SYSTEM DSN FOR AN ACCESS DATABASE
'PARAMETERS: 'DSNName = DSN Name
'DatabaseFullPath = Full Path to .mdb file
'RETURNS: True if successful, false otherwise
'EXAMPLE: CreateAccessDSN "MyDSN", "C:\MyDb.mdb"
Dim sAttributes As String
'TEST TO SEE IF FILE EXISTS: YOU CAN REMOVE IF YOU
'DON'T WANT IT
If dir(DatabaseFullPath) = "" Then Exit Function
sAttributes = "DSN=" & DSNName & Chr(0)
sAttributes = sAttributes & "DBQ=" & DatabaseFullPath & Chr(0)
CreateAccessDSN = CreateDSN("Microsoft Access Driver (*.mdb)", _
sAttributes)
End Function
Public Function CreateDSN(Driver As String, Attributes As _
String) As Boolean
'PURPOSE: CREATES A SYSTEM DSN
'PARAMETERS: 'Driver = DriverName
'ATTRIBUTES: 'Attributes; varies as a function
'of the Driver
'EXAMPLE: Refer to Code Above
CreateDSN = SQLConfigDataSource(0&, ODBC_ADD_SYS_DSN, _
Driver, Attributes)
End Function
Public Function isFileExist(filePath As String) As Boolean
On Error GoTo EH
If filePath <> "" And dir$(filePath) <> "" Then
isFileExist = True
Else
isFileExist = False
End If
Exit Function
EH:
isFileExist = False
End Function
Private Sub Form_Load()
Dim regDSNPath As String
Dim myDBPath As String
Dim DSNName As String
DSNName = "abc"
myDBPath = Replace$(App.path & "\Database\MyDb.Mdb", "\\", "\")
If isFileExist(myDBPath) = False Then
MsgBox "Database Not Found!"
Exit Sub
End If
regDSNPath = QueryValue(HKEY_LOCAL_MACH INE, "SOFTWARE\ODBC\ODBC.INI\" & DSNName, "DBQ")
If regDSNPath = "" Then
CreateAccessDSN DSNName, myDBPath
MsgBox "DSN Created!"
ElseIf isFileExist(regDSNPath) = False Then
CreateAccessDSN DSNName, myDBPath
MsgBox "DSN Updated!"
Else
MsgBox "DSN is ok, db path is correct"
End If
End Sub
Option Explicit
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" _
(ByVal hwndParent As Long, ByVal fRequest As Long, _
ByVal lpszDriver As String, ByVal lpszAttributes As String) _
As Long
Private Const ODBC_ADD_SYS_DSN = 4
Public Function CreateSQLServerDSN(DSNName
ServerName As String, Database As String) As Boolean
'PURPOSE: 'CREATES A SYSTEM DSN FOR AN SQL SERVER DATABASE
'PARAMETERS: 'DSNName = DSN Name
'ServerName = Name of Server
'Database = Database to Use
'RETURNS: True if successful, false otherwise
'EXAMPLE: CreateSQLServerDSN "MyDSN", "MyServer", "MyDatabase"
Dim sAttributes As String
sAttributes = "DSN=" & DSNName & Chr(0)
sAttributes = sAttributes & "Server=" & ServerName & Chr(0)
sAttributes = sAttributes & "Database=" & Database & Chr(0)
CreateSQLServerDSN = CreateDSN("SQL Server", sAttributes)
End Function
Public Function CreateAccessDSN(DSNName As String, _
DatabaseFullPath As String) As Boolean
'PURPOSE: 'CREATES A SYSTEM DSN FOR AN ACCESS DATABASE
'PARAMETERS: 'DSNName = DSN Name
'DatabaseFullPath = Full Path to .mdb file
'RETURNS: True if successful, false otherwise
'EXAMPLE: CreateAccessDSN "MyDSN", "C:\MyDb.mdb"
Dim sAttributes As String
'TEST TO SEE IF FILE EXISTS: YOU CAN REMOVE IF YOU
'DON'T WANT IT
If dir(DatabaseFullPath) = "" Then Exit Function
sAttributes = "DSN=" & DSNName & Chr(0)
sAttributes = sAttributes & "DBQ=" & DatabaseFullPath & Chr(0)
CreateAccessDSN = CreateDSN("Microsoft Access Driver (*.mdb)", _
sAttributes)
End Function
Public Function CreateDSN(Driver As String, Attributes As _
String) As Boolean
'PURPOSE: CREATES A SYSTEM DSN
'PARAMETERS: 'Driver = DriverName
'ATTRIBUTES: 'Attributes; varies as a function
'of the Driver
'EXAMPLE: Refer to Code Above
CreateDSN = SQLConfigDataSource(0&, ODBC_ADD_SYS_DSN, _
Driver, Attributes)
End Function
Public Function isFileExist(filePath As String) As Boolean
On Error GoTo EH
If filePath <> "" And dir$(filePath) <> "" Then
isFileExist = True
Else
isFileExist = False
End If
Exit Function
EH:
isFileExist = False
End Function
Private Sub Form_Load()
Dim regDSNPath As String
Dim myDBPath As String
Dim DSNName As String
DSNName = "abc"
myDBPath = Replace$(App.path & "\Database\MyDb.Mdb", "\\", "\")
If isFileExist(myDBPath) = False Then
MsgBox "Database Not Found!"
Exit Sub
End If
regDSNPath = QueryValue(HKEY_LOCAL_MACH
If regDSNPath = "" Then
CreateAccessDSN DSNName, myDBPath
MsgBox "DSN Created!"
ElseIf isFileExist(regDSNPath) = False Then
CreateAccessDSN DSNName, myDBPath
MsgBox "DSN Updated!"
Else
MsgBox "DSN is ok, db path is correct"
End If
End Sub
also add this Registry Module by adding it into a New Module:
Option Explicit
Global Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259
Global Const KEY_ALL_ACCESS = &H3F
Global Const REG_OPTION_NON_VOLATILE = 0
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Public Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Public Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
Public Result As Long
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
' Description:
' This Function will Delete a key
'
' Syntax:
' DeleteKey Location, KeyName
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is name of the key you wish to delete, it may include subkeys (example "Key1\SubKey1")
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'open the specified key
'lRetVal = RegOpenKeyEx(lPredefinedKe y, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteKey(lPredefinedKe y, sKeyName)
'RegCloseKey (hKey)
End Function
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
' Description:
' This Function will delete a value
'
' Syntax:
' DeleteValue Location, KeyName, ValueName
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is the name of the key that the value you wish to delete is in
' , it may include subkeys (example "Key1\SubKey1")
'
' ValueName is the name of value you wish to delete
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'open the specified key
lRetVal = RegOpenKeyEx(lPredefinedKe y, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End Function
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKe y, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch)
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
Public Function CreateNewKey(lPredefinedKe y As Long, sNewKeyName As String)
' Description:
' This Function will create a new key
'
' Syntax:
' QueryValue Location, KeyName
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is name of the key you wish to create, it may include subkeys (example "Key1\SubKey1")
Dim hNewKey As Long 'handle to the new key
Dim lRetVal As Long 'result of the RegCreateKeyEx function
lRetVal = RegCreateKeyEx(lPredefined Key, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Function
Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
' Description:
' This Function will set the data field of a value
'
' Syntax:
' QueryValue Location, KeyName, ValueName, ValueSetting, ValueType
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is the key that the value is under (example: "Key1\SubKey1")
'
' ValueName is the name of the value you want create, or set the value of (example: "ValueTest")
'
' ValueSetting is what you want the value to equal
'
' ValueType must equal either REG_SZ (a string) Or REG_DWORD (an integer)
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'open the specified key
lRetVal = RegOpenKeyEx(lPredefinedKe y, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)
End Function
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
' Description:
' This Function will return the data field of a value
'
' Syntax:
' Variable = QueryValue(Location, KeyName, ValueName)
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is the key that the value is under (example: "Software\Microsoft\Window s\CurrentV ersion\Exp lorer")
'
' ValueName is the name of the value you want to access (example: "link")
Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value
lRetVal = RegOpenKeyEx(lPredefinedKe y, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)
End Function
Option Explicit
Global Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259
Global Const KEY_ALL_ACCESS = &H3F
Global Const REG_OPTION_NON_VOLATILE = 0
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Public Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Public Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
Public Result As Long
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
' Description:
' This Function will Delete a key
'
' Syntax:
' DeleteKey Location, KeyName
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is name of the key you wish to delete, it may include subkeys (example "Key1\SubKey1")
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'open the specified key
'lRetVal = RegOpenKeyEx(lPredefinedKe
lRetVal = RegDeleteKey(lPredefinedKe
'RegCloseKey (hKey)
End Function
Public Function DeleteValue(lPredefinedKey
' Description:
' This Function will delete a value
'
' Syntax:
' DeleteValue Location, KeyName, ValueName
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is the name of the key that the value you wish to delete is in
' , it may include subkeys (example "Key1\SubKey1")
'
' ValueName is the name of value you wish to delete
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'open the specified key
lRetVal = RegOpenKeyEx(lPredefinedKe
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End Function
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey,
If lrc <> ERROR_NONE Then Error 5
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKe
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch)
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey,
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
Public Function CreateNewKey(lPredefinedKe
' Description:
' This Function will create a new key
'
' Syntax:
' QueryValue Location, KeyName
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is name of the key you wish to create, it may include subkeys (example "Key1\SubKey1")
Dim hNewKey As Long 'handle to the new key
Dim lRetVal As Long 'result of the RegCreateKeyEx function
lRetVal = RegCreateKeyEx(lPredefined
RegCloseKey (hNewKey)
End Function
Public Function SetKeyValue(lPredefinedKey
' Description:
' This Function will set the data field of a value
'
' Syntax:
' QueryValue Location, KeyName, ValueName, ValueSetting, ValueType
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is the key that the value is under (example: "Key1\SubKey1")
'
' ValueName is the name of the value you want create, or set the value of (example: "ValueTest")
'
' ValueSetting is what you want the value to equal
'
' ValueType must equal either REG_SZ (a string) Or REG_DWORD (an integer)
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'open the specified key
lRetVal = RegOpenKeyEx(lPredefinedKe
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)
End Function
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
' Description:
' This Function will return the data field of a value
'
' Syntax:
' Variable = QueryValue(Location, KeyName, ValueName)
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is the key that the value is under (example: "Software\Microsoft\Window
'
' ValueName is the name of the value you want to access (example: "link")
Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value
lRetVal = RegOpenKeyEx(lPredefinedKe
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)
End Function
ASKER
Good
its working
BUT Sorry ........ i just checked again the following
http://www.freevbcode.com/ShowCode.Asp?ID=502
its also working perfectly to overwirte
so no need for adding more complexity ... i am writing this for future readers
anyhow thanx ... A little more is ...
my Access Db is password protected BUT now i am facing problem in opening connection with this database. when i test the connection it shows invalid username password are path BUT i am actually gave proper path ????
Could U provide me the string for a password protected DB. with jet ole db 4
waiting
its working
BUT Sorry ........ i just checked again the following
http://www.freevbcode.com/ShowCode.Asp?ID=502
its also working perfectly to overwirte
so no need for adding more complexity ... i am writing this for future readers
anyhow thanx ... A little more is ...
my Access Db is password protected BUT now i am facing problem in opening connection with this database. when i test the connection it shows invalid username password are path BUT i am actually gave proper path ????
Could U provide me the string for a password protected DB. with jet ole db 4
waiting
>>Could U provide me the string for a password protected DB. with jet ole db 4
Take a look at:
http://www.able-consulting.com/ADO_Conn.htm
http://www.connectionstrings.com
Frankly, i'm very not satified with the grade "C", any reason why will be good.
Take a look at:
http://www.able-consulting.com/ADO_Conn.htm
http://www.connectionstrings.com
Frankly, i'm very not satified with the grade "C", any reason why will be good.
ASKER
Oh sorry ! That was my mistake...i wanted to give you a grace B....really sorry abt that.
i will take look to above URLs and will give you more points..
and sorry again
i will take look to above URLs and will give you more points..
and sorry again
Hi riazpk,
Try to do this:
Post a 0 pts question at Community Support (https://www.experts-exchange.com/Community_Support/) and request for a change grade.
If you dont know how to do it, just let me know.
cheers
Try to do this:
Post a 0 pts question at Community Support (https://www.experts-exchange.com/Community_Support/) and request for a change grade.
If you dont know how to do it, just let me know.
cheers
ASKER
i have already tried these solutions BUT
Please Read the Question Carefully
i want to overwrite the path
what if Source folder is moved to another location and when the application runs again then DSN is there but path is not valid. i want to check and confirm that path each time.
so Please reply accordingly