Testing for ODBC names

  • Thread starter Thread starter jodleren
  • Start date Start date
J

jodleren

Hi all

I want to get a list of ODBC connections, and then pick one - the
point is, that the connection I am looking for might be spelled
differently (e.g. with space). So with a list I can find it eaily.

Any suggestions?
Sonnich
 
The ODBC connections i a workbook are the queries you created.  the
appear in the workbook names.  So you can search through the names.
Youcan see the named in one of two palces

1) Insert Name define
2) File Property custom

You can also find all the queries in a workbook and then look at the
conenction property.

for each sht in sheets
for each qry in sht.queries
Click to expand...

Not exactly what I want.... I want to get a list of possible ODBC
connections, as in the ODBC settings window.
I am now trying to get that from the registry, I found an example
here, but that does not work either.

Basically, I need the value names from HKEY_LOCAL_MACHINE\SOFTWARE\ODBC
\ODBC.INI\ODBC Data Sources

Then I have what I want.

Sonnich
 
Hi all

I want to get a list of ODBC connections, and then pick one - the
point is, that the connection I am looking for might be spelled
differently (e.g. with space). So with a list I can find it eaily.

Any suggestions?
Sonnich
Click to expand...

This almost works - it gets the amount, but data is empty. Anybody
knows why?

Private 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
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias
"RegQueryInfoKeyA" ( _
ByVal hKey As Long, _
ByVal lpClass As String, _
lpcbClass As Long, _
ByVal lpReserved As Long, _
lpcSubKeys As Long, _
lpcbMaxSubKeyLen As Long, _
lpcbMaxClassLen As Long, _
lpcValues As Long, _
lpcbMaxValueNameLen As Long, _
lpcbMaxValueLen As Long, _
lpcbSecurityDescriptor As Long, _
lpftLastWriteTime As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias
"RegEnumValueA" ( _
ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpValueName As String, _
lpcbValueName As Long, _
ByVal lpReserved As Long, _
lpType As Long, _
ByVal lpData As String, _
lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As
Long) As Long
Private 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

' Registry value type definitions
Private Const REG_NONE As Long = 0
Private Const REG_SZ As Long = 1
Private Const REG_EXPAND_SZ As Long = 2
Private Const REG_BINARY As Long = 3
Private Const REG_DWORD As Long = 4
Private Const REG_LINK As Long = 6
Private Const REG_MULTI_SZ As Long = 7
Private Const REG_RESOURCE_LIST As Long = 8

Private Sub CommandButton1_Click()
Dim mCurrentKey As Long
Result = RegOpenKeyEx(&H80000002, "SOFTWARE\ODBC\ODBC.INI\ODBC Data
Sources", 0&, &H2001D, mCurrentKey)

Dim DataType As Long
Dim Value As String
Dim ValueLength As Long
Dim ReadString As String
' Dim Result As Long
If False Then // this works
Result = RegQueryValueExString(mCurrentKey, "ChinaWise", 0&,
DataType, vbNullString, ValueLength)
If Result = ERROR_SUCCESS Then
Value = Space(ValueLength)
Result = RegQueryValueExString(mCurrentKey, "ChinaWise", 0&,
DataType, Value, ValueLength)
If Result = ERROR_SUCCESS Then
Select Case DataType
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
ReadString = Left(Value, ValueLength - 1)
Case Else
Err.Raise vbObjectError + 515, , "Not a string value: " &
Name
End Select
End If
End If
If Result <> ERROR_SUCCESS Then
Err.Raise vbObjectError + 515, , "Cannot read string value: " &
Name
End If
End If

Dim Values()
ReDim Preserve Values(0)

' Dim Name As String
Dim NameLength As Long
Dim ValueCount As Long
Dim MaxValueLength As Long
Dim i As Long

If RegQueryInfoKey(mCurrentKey, vbNullString, 0&, 0&, 0&, 0&, 0&,
ValueCount, MaxValueLength, 0&, 0&, 0&) = ERROR_SUCCESS Then
If ValueCount > 0 Then
ReDim Values(0 To ValueCount - 1)
Else
Values = Split("")
End If
MaxValueLength = MaxValueLength + 1
sName = Space(MaxValueLength) // always empty - why?
For i = 0 To ValueCount - 1
NameLength = MaxValueLength
If RegEnumValue(mCurrentKey, i, sName, NameLength, 0&, 0&,
vbNullString, 0&) = ERROR_SUCCESS Then
Values(i) = Left(sName, NameLength)
Else
Err.Raise vbObjectError + 520, , "Error reading value name"
End If
Next
Else
Err.Raise vbObjectError + 521, , "Error reading value names"
End If

RegCloseKey (mCurrentKey)

'GetValueNames (names)
For i = 0 To UBound(Values)
Cells(1 + i, 1) = i
Cells(1 + i, 2) = Values(i)
Next

End Sub
 
Make sure your are using the correct registry path.  You did have the
root entry.  You registry search was using the default vbalue which I'm
not sure was the current user.

Result = RegOpenKeyEx(&H80000002,
"\HKEY_CURRENT_USER\SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources ", 0&,
&H2001D, mCurrentKey)

I added Current user.  First open the resitry editor and see if the
entry is in the registry

Start Button : Run regedit
Click to expand...

That is what the first number is there for
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006

and the data is under local machine :)
 
Maybe not exactly what you are asking for, but this code may come in useful:

Option Explicit
Private Declare Function SQLDataSources Lib "odbc32.dll" _
(ByVal hEnv As Long, _
ByVal fDirection As Integer, _
ByVal szDSN As String, _
ByVal cbDSNMax As Integer, _
ByRef pcbDSN As Integer, _
ByVal szDescription As String, _
ByVal cbDescriptionMax As Integer,
_
ByRef pcbDescription As Integer) As
Long
Private Declare Function SQLAllocHandle Lib "odbc32.dll" _
(ByVal HandleType As Integer, _
ByVal InputHandle As Long, _
ByRef OutputHandlePtr As Long) As
Long
Private Declare Function SQLSetEnvAttr Lib "odbc32.dll" _
(ByVal EnvironmentHandle As Long, _
ByVal dwAttribute As Long, _
ByVal ValuePtr As Long, _
ByVal StringLen As Long) As Long
Private Declare Function SQLFreeHandle Lib "odbc32.dll" _
(ByVal HandleType As Integer, _
ByVal Handle As Long) As Long
Private Const SQL_MAX_DSN_LENGTH As Long = 128
Private Const SQL_MAX_DESC_LENGTH As Long = 128
Private Const SQL_SUCCESS As Long = 0
Private Const SQL_FETCH_NEXT As Long = 1
Private Const SQL_NULL_HANDLE As Long = 0
Private Const SQL_HANDLE_ENV As Long = 1
Private Const SQL_ATTR_ODBC_VERSION As Long = 200
Private Const SQL_OV_ODBC3 As Long = 3
Private Const SQL_IS_INTEGER As Long = (-6)

Function GetDSNs(Optional strDriverPartial As String, _
Optional bShowDrivers As Boolean) As String()

Dim i As Long
Dim hEnv As Long 'handle to the environment
Dim sServer As String
Dim sDriver As String
Dim nSvrLen As Integer
Dim nDvrLen As Integer
Dim arrDSN() As String

Dim collDSNs As Collection
Dim collDrivers As Collection

Set collDSNs = New Collection
Set collDrivers = New Collection

strDriverPartial = UCase(strDriverPartial)

On Error Resume Next

'obtain a handle to the environment
If SQLAllocHandle(SQL_HANDLE_ENV, _
SQL_NULL_HANDLE, _
hEnv) <> 0 Then

'if successful, set the
'environment for subsequent calls
If SQLSetEnvAttr(hEnv, _
SQL_ATTR_ODBC_VERSION, _
SQL_OV_ODBC3, _
SQL_IS_INTEGER) <> 0 Then

'set up the strings for the call
sServer = Space$(SQL_MAX_DSN_LENGTH)
sDriver = Space$(SQL_MAX_DESC_LENGTH)

'load the DSN names
Do While SQLDataSources(hEnv, _
SQL_FETCH_NEXT, _
sServer, _
SQL_MAX_DSN_LENGTH, _
nSvrLen, _
sDriver, _
SQL_MAX_DESC_LENGTH, _
nDvrLen) = SQL_SUCCESS

'add data to the controls
If Len(strDriverPartial) > 0 Then
If InStr(1, UCase(Left$(sDriver, nDvrLen)), _
strDriverPartial, _
vbBinaryCompare) > 0 Then
'so we avoid duplicate DSN's
'---------------------------
collDSNs.Add Left$(sServer, nSvrLen), Left$(sServer, nSvrLen)
If bShowDrivers Then
collDrivers.Add Left$(sDriver, nDvrLen)
End If
End If
Else
collDSNs.Add Left$(sServer, nSvrLen), Left$(sServer, nSvrLen)
If bShowDrivers Then
collDrivers.Add Left$(sDriver, nDvrLen)
End If
End If

'repad the strings
sServer = Space$(SQL_MAX_DSN_LENGTH)
sDriver = Space$(SQL_MAX_DESC_LENGTH)

Loop

End If 'If SQLSetEnvAttr

'clean up
Call SQLFreeHandle(SQL_HANDLE_ENV, hEnv)

End If 'If SQLAllocHandle

If collDSNs.Count > 0 Then

If bShowDrivers Then
'so in this case return a 2-D array
'----------------------------------
ReDim arrDSN(1 To collDSNs.Count, 1 To 2)

For i = 1 To collDSNs.Count
arrDSN(i, 1) = collDSNs(i)
arrDSN(i, 2) = collDrivers(i)
Next i
Else
ReDim arrDSN(1 To collDSNs.Count)

For i = 1 To collDSNs.Count
arrDSN(i) = collDSNs(i)
Next i
End If
End If

GetDSNs = arrDSN

End Function


RBS
 
Back
Top