Solved

Set ODBC using VB code

Posted on 2001-06-07
10
245 Views
Last Modified: 2011-08-18
Hi.. Can I set ODBC user DSN by using VB code???
I use VB6 and crystal report v.8.0 and OS win 2000. I don't want to set ODBC to every computer I install my application.
0
Comment
Question by:orasaj
10 Comments
 
LVL 2

Accepted Solution

by:
Microsoft earned 200 total points
ID: 6164698
HMMMM

DOE THIS WORK

'**************************************
' Name: Create/Check Access' DSN in ODBC
'    
' Description:Code You can use for check
'     and (if not exist) create DSN for Access
'     DB in ODBC.
' By: Tair Abdurman
'
'
' Inputs:None
'
' Returns:None
'
'Assumes:None
'
'Side Effects:None
'This code is copyrighted and has limite
'     d warranties.
'Please see http://www.Planet-Source-Cod
'     e.com/xq/ASP/txtCodeId.5225/lngWId.1/qx/
'     vb/scripts/ShowCode.htm
'for details.
'**************************************

'in module file
Private Const KEY_QUERY_VALUE = &H1
Private Const ERROR_SUCCESS = 0&
Private Const REG_SZ = 1
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_DWORD = 4


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 RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.


Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long


Private 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


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


Private 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 Function isSZKeyExist(szKeyPath As String, _
    szKeyName As String, _
    ByRef szKeyValue As String) As Boolean
    Dim bRes As Boolean
    Dim lRes As Long
    Dim hKey As Long
    lRes = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
    szKeyPath, _
    0&, _
    KEY_QUERY_VALUE, _
    hKey)


    If lRes <> ERROR_SUCCESS Then
        isSZKeyExist = False
        Exit Function
    End If
    lRes = RegQueryValueEx(hKey, _
    szKeyName, _
    0&, _
    REG_SZ, _
    ByVal szKeyValue, _
    Len(szKeyValue))
    RegCloseKey (hKey)


    If lRes <> ERROR_SUCCESS Then
        isSZKeyExist = False
        Exit Function
    End If
    isSZKeyExist = True
End Function


Public Function checkAccessDriver(ByRef szDriverName As String) As Boolean
    Dim szKeyPath As String
    Dim szKeyName As String
    Dim szKeyValue As String
    Dim bRes As Boolean
   
   
    bRes = False
   
    szKeyPath = "SOFTWARE\ODBC\ODBCINST.INI\Microsoft Access Driver (*.mdb)"
    szKeyName = "Driver"
    szKeyValue = String(255, Chr(32))
   


    If isSZKeyExist(szKeyPath, szKeyName, szKeyValue) Then
        szDriverName = szKeyValue
        bRes = True
    Else
        bRes = False
    End If
   
    checkAccessDriver = bRes
End Function


Public Function checkWantedAccessDSN(szWantedDSN As String) As Boolean
    Dim szKeyPath As String
    Dim szKeyName As String
    Dim szKeyValue As String
    Dim bRes As Boolean
   
    szKeyPath = "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources"
    szKeyName = szWantedDSN
    szKeyValue = String(255, Chr(32))
   


    If isSZKeyExist(szKeyPath, szKeyName, szKeyValue) Then
        bRes = True
    Else
        bRes = False
    End If
   
    checkWantedAccessDSN = bRes
   
End Function


Public Function createAccessDSN(szDriverName As String, _
    szWantedDSN As String) As Boolean
   
    Dim hKey As Long
    Dim szKeyPath As String
    Dim szKeyName As String
    Dim szKeyValue As String
    Dim lKeyValue As Long
    Dim lRes As Long
    Dim lSize As Long
    Dim szEmpty As String
   
    szEmpty = Chr(0)
   
   
    lSize = 4
    lRes = RegCreateKey(HKEY_LOCAL_MACHINE, _
    "SOFTWARE\ODBC\ODBC.INI\" & _
    szWantedDSN, _
    hKey)
   


    If lRes <> ERROR_SUCCESS Then
        createAccessDSN = False
        Exit Function
    End If
   
    lRes = RegSetValueExString(hKey, "UID", 0&, REG_SZ, _
    szEmpty, Len(szEmpty))
   
    szKeyValue = App.Path & "\DB\ssmdb.mdb"
    lRes = RegSetValueExString(hKey, "DBQ", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    szKeyValue = szDriverName
    lRes = RegSetValueExString(hKey, "Driver", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    szKeyValue = "MS Access;"
    lRes = RegSetValueExString(hKey, "FIL", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    lKeyValue = 25
    lRes = RegSetValueExLong(hKey, "DriverId", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lKeyValue = 0
    lRes = RegSetValueExLong(hKey, "SafeTransactions", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lRes = RegCloseKey(hKey)
    szKeyPath = "SOFTWARE\ODBC\ODBC.INI\" & szWantedDSN & "\Engines\Jet"
   
    lRes = RegCreateKey(HKEY_LOCAL_MACHINE, _
    szKeyPath, _
    hKey)
   


    If lRes <> ERROR_SUCCESS Then
        createAccessDSN = False
        Exit Function
    End If
    lRes = RegSetValueExString(hKey, "ImplicitCommitSync", 0&, REG_SZ, _
    szEmpty, Len(szEmpty))
    szKeyValue = "Yes"
    lRes = RegSetValueExString(hKey, "UserCommitSync", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    lKeyValue = 2048
    lRes = RegSetValueExLong(hKey, "MaxBufferSize", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lKeyValue = 5
    lRes = RegSetValueExLong(hKey, "PageTimeout", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lKeyValue = 3
    lRes = RegSetValueExLong(hKey, "Threads", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lRes = RegCloseKey(hKey)
    lRes = RegCreateKey(HKEY_LOCAL_MACHINE, _
    "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", _
    hKey)
   


    If lRes <> ERROR_SUCCESS Then
        createAccessDSN = False
        Exit Function
    End If
   
    szKeyValue = "Microsoft Access Driver (*.mdb)"
    lRes = RegSetValueExString(hKey, szWantedDSN, 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
   
    lRes = RegCloseKey(hKey)
    createAccessDSN = True
End Function
'anywhere in application

Dim szDriverName As String
Dim szWantedDSN As String

szDriverName = String(255, Chr(32))
szWantedDSN = "MyAccess_ODBC"
'is access drivers installed?


If Not checkAccessDriver(szDriverName) Then
    MsgBox "You must Install Access ODBC Drivers before use this program.", vbOK + vbCritical
End If

'is our dsn exist?


If Not (checkWantedAccessDSN(szWantedDSN)) Then


    If szDriverName = "" Then
        MsgBox "Can't find access ODBC driver.", vbOK + vbCritical
    Else


        If Not createAccessDSN(szDriverName, szWantedDSN) Then
            MsgBox "Can't create database ODBC.", vbOK + vbCritical
        End If
    End If
End If


            
0
 
LVL 2

Expert Comment

by:Microsoft
ID: 6164701
HMMMM

DOE THIS WORK

'**************************************
' Name: Create/Check Access' DSN in ODBC
'    
' Description:Code You can use for check
'     and (if not exist) create DSN for Access
'     DB in ODBC.
' By: Tair Abdurman
'
'
' Inputs:None
'
' Returns:None
'
'Assumes:None
'
'Side Effects:None
'This code is copyrighted and has limite
'     d warranties.
'Please see http://www.Planet-Source-Cod
'     e.com/xq/ASP/txtCodeId.5225/lngWId.1/qx/
'     vb/scripts/ShowCode.htm
'for details.
'**************************************

'in module file
Private Const KEY_QUERY_VALUE = &H1
Private Const ERROR_SUCCESS = 0&
Private Const REG_SZ = 1
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_DWORD = 4


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 RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.


Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long


Private 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


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


Private 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 Function isSZKeyExist(szKeyPath As String, _
    szKeyName As String, _
    ByRef szKeyValue As String) As Boolean
    Dim bRes As Boolean
    Dim lRes As Long
    Dim hKey As Long
    lRes = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
    szKeyPath, _
    0&, _
    KEY_QUERY_VALUE, _
    hKey)


    If lRes <> ERROR_SUCCESS Then
        isSZKeyExist = False
        Exit Function
    End If
    lRes = RegQueryValueEx(hKey, _
    szKeyName, _
    0&, _
    REG_SZ, _
    ByVal szKeyValue, _
    Len(szKeyValue))
    RegCloseKey (hKey)


    If lRes <> ERROR_SUCCESS Then
        isSZKeyExist = False
        Exit Function
    End If
    isSZKeyExist = True
End Function


Public Function checkAccessDriver(ByRef szDriverName As String) As Boolean
    Dim szKeyPath As String
    Dim szKeyName As String
    Dim szKeyValue As String
    Dim bRes As Boolean
   
   
    bRes = False
   
    szKeyPath = "SOFTWARE\ODBC\ODBCINST.INI\Microsoft Access Driver (*.mdb)"
    szKeyName = "Driver"
    szKeyValue = String(255, Chr(32))
   


    If isSZKeyExist(szKeyPath, szKeyName, szKeyValue) Then
        szDriverName = szKeyValue
        bRes = True
    Else
        bRes = False
    End If
   
    checkAccessDriver = bRes
End Function


Public Function checkWantedAccessDSN(szWantedDSN As String) As Boolean
    Dim szKeyPath As String
    Dim szKeyName As String
    Dim szKeyValue As String
    Dim bRes As Boolean
   
    szKeyPath = "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources"
    szKeyName = szWantedDSN
    szKeyValue = String(255, Chr(32))
   


    If isSZKeyExist(szKeyPath, szKeyName, szKeyValue) Then
        bRes = True
    Else
        bRes = False
    End If
   
    checkWantedAccessDSN = bRes
   
End Function


Public Function createAccessDSN(szDriverName As String, _
    szWantedDSN As String) As Boolean
   
    Dim hKey As Long
    Dim szKeyPath As String
    Dim szKeyName As String
    Dim szKeyValue As String
    Dim lKeyValue As Long
    Dim lRes As Long
    Dim lSize As Long
    Dim szEmpty As String
   
    szEmpty = Chr(0)
   
   
    lSize = 4
    lRes = RegCreateKey(HKEY_LOCAL_MACHINE, _
    "SOFTWARE\ODBC\ODBC.INI\" & _
    szWantedDSN, _
    hKey)
   


    If lRes <> ERROR_SUCCESS Then
        createAccessDSN = False
        Exit Function
    End If
   
    lRes = RegSetValueExString(hKey, "UID", 0&, REG_SZ, _
    szEmpty, Len(szEmpty))
   
    szKeyValue = App.Path & "\DB\ssmdb.mdb"
    lRes = RegSetValueExString(hKey, "DBQ", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    szKeyValue = szDriverName
    lRes = RegSetValueExString(hKey, "Driver", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    szKeyValue = "MS Access;"
    lRes = RegSetValueExString(hKey, "FIL", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    lKeyValue = 25
    lRes = RegSetValueExLong(hKey, "DriverId", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lKeyValue = 0
    lRes = RegSetValueExLong(hKey, "SafeTransactions", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lRes = RegCloseKey(hKey)
    szKeyPath = "SOFTWARE\ODBC\ODBC.INI\" & szWantedDSN & "\Engines\Jet"
   
    lRes = RegCreateKey(HKEY_LOCAL_MACHINE, _
    szKeyPath, _
    hKey)
   


    If lRes <> ERROR_SUCCESS Then
        createAccessDSN = False
        Exit Function
    End If
    lRes = RegSetValueExString(hKey, "ImplicitCommitSync", 0&, REG_SZ, _
    szEmpty, Len(szEmpty))
    szKeyValue = "Yes"
    lRes = RegSetValueExString(hKey, "UserCommitSync", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    lKeyValue = 2048
    lRes = RegSetValueExLong(hKey, "MaxBufferSize", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lKeyValue = 5
    lRes = RegSetValueExLong(hKey, "PageTimeout", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lKeyValue = 3
    lRes = RegSetValueExLong(hKey, "Threads", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lRes = RegCloseKey(hKey)
    lRes = RegCreateKey(HKEY_LOCAL_MACHINE, _
    "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", _
    hKey)
   


    If lRes <> ERROR_SUCCESS Then
        createAccessDSN = False
        Exit Function
    End If
   
    szKeyValue = "Microsoft Access Driver (*.mdb)"
    lRes = RegSetValueExString(hKey, szWantedDSN, 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
   
    lRes = RegCloseKey(hKey)
    createAccessDSN = True
End Function
'anywhere in application

Dim szDriverName As String
Dim szWantedDSN As String

szDriverName = String(255, Chr(32))
szWantedDSN = "MyAccess_ODBC"
'is access drivers installed?


If Not checkAccessDriver(szDriverName) Then
    MsgBox "You must Install Access ODBC Drivers before use this program.", vbOK + vbCritical
End If

'is our dsn exist?


If Not (checkWantedAccessDSN(szWantedDSN)) Then


    If szDriverName = "" Then
        MsgBox "Can't find access ODBC driver.", vbOK + vbCritical
    Else


        If Not createAccessDSN(szDriverName, szWantedDSN) Then
            MsgBox "Can't create database ODBC.", vbOK + vbCritical
        End If
    End If
End If


            
0
 
LVL 2

Expert Comment

by:Microsoft
ID: 6164702
HMMMM

DOE THIS WORK

'**************************************
' Name: Create/Check Access' DSN in ODBC
'    
' Description:Code You can use for check
'     and (if not exist) create DSN for Access
'     DB in ODBC.
' By: Tair Abdurman
'
'
' Inputs:None
'
' Returns:None
'
'Assumes:None
'
'Side Effects:None
'This code is copyrighted and has limite
'     d warranties.
'Please see http://www.Planet-Source-Cod
'     e.com/xq/ASP/txtCodeId.5225/lngWId.1/qx/
'     vb/scripts/ShowCode.htm
'for details.
'**************************************

'in module file
Private Const KEY_QUERY_VALUE = &H1
Private Const ERROR_SUCCESS = 0&
Private Const REG_SZ = 1
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_DWORD = 4


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 RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.


Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long


Private 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


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


Private 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 Function isSZKeyExist(szKeyPath As String, _
    szKeyName As String, _
    ByRef szKeyValue As String) As Boolean
    Dim bRes As Boolean
    Dim lRes As Long
    Dim hKey As Long
    lRes = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
    szKeyPath, _
    0&, _
    KEY_QUERY_VALUE, _
    hKey)


    If lRes <> ERROR_SUCCESS Then
        isSZKeyExist = False
        Exit Function
    End If
    lRes = RegQueryValueEx(hKey, _
    szKeyName, _
    0&, _
    REG_SZ, _
    ByVal szKeyValue, _
    Len(szKeyValue))
    RegCloseKey (hKey)


    If lRes <> ERROR_SUCCESS Then
        isSZKeyExist = False
        Exit Function
    End If
    isSZKeyExist = True
End Function


Public Function checkAccessDriver(ByRef szDriverName As String) As Boolean
    Dim szKeyPath As String
    Dim szKeyName As String
    Dim szKeyValue As String
    Dim bRes As Boolean
   
   
    bRes = False
   
    szKeyPath = "SOFTWARE\ODBC\ODBCINST.INI\Microsoft Access Driver (*.mdb)"
    szKeyName = "Driver"
    szKeyValue = String(255, Chr(32))
   


    If isSZKeyExist(szKeyPath, szKeyName, szKeyValue) Then
        szDriverName = szKeyValue
        bRes = True
    Else
        bRes = False
    End If
   
    checkAccessDriver = bRes
End Function


Public Function checkWantedAccessDSN(szWantedDSN As String) As Boolean
    Dim szKeyPath As String
    Dim szKeyName As String
    Dim szKeyValue As String
    Dim bRes As Boolean
   
    szKeyPath = "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources"
    szKeyName = szWantedDSN
    szKeyValue = String(255, Chr(32))
   


    If isSZKeyExist(szKeyPath, szKeyName, szKeyValue) Then
        bRes = True
    Else
        bRes = False
    End If
   
    checkWantedAccessDSN = bRes
   
End Function


Public Function createAccessDSN(szDriverName As String, _
    szWantedDSN As String) As Boolean
   
    Dim hKey As Long
    Dim szKeyPath As String
    Dim szKeyName As String
    Dim szKeyValue As String
    Dim lKeyValue As Long
    Dim lRes As Long
    Dim lSize As Long
    Dim szEmpty As String
   
    szEmpty = Chr(0)
   
   
    lSize = 4
    lRes = RegCreateKey(HKEY_LOCAL_MACHINE, _
    "SOFTWARE\ODBC\ODBC.INI\" & _
    szWantedDSN, _
    hKey)
   


    If lRes <> ERROR_SUCCESS Then
        createAccessDSN = False
        Exit Function
    End If
   
    lRes = RegSetValueExString(hKey, "UID", 0&, REG_SZ, _
    szEmpty, Len(szEmpty))
   
    szKeyValue = App.Path & "\DB\ssmdb.mdb"
    lRes = RegSetValueExString(hKey, "DBQ", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    szKeyValue = szDriverName
    lRes = RegSetValueExString(hKey, "Driver", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    szKeyValue = "MS Access;"
    lRes = RegSetValueExString(hKey, "FIL", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    lKeyValue = 25
    lRes = RegSetValueExLong(hKey, "DriverId", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lKeyValue = 0
    lRes = RegSetValueExLong(hKey, "SafeTransactions", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lRes = RegCloseKey(hKey)
    szKeyPath = "SOFTWARE\ODBC\ODBC.INI\" & szWantedDSN & "\Engines\Jet"
   
    lRes = RegCreateKey(HKEY_LOCAL_MACHINE, _
    szKeyPath, _
    hKey)
   


    If lRes <> ERROR_SUCCESS Then
        createAccessDSN = False
        Exit Function
    End If
    lRes = RegSetValueExString(hKey, "ImplicitCommitSync", 0&, REG_SZ, _
    szEmpty, Len(szEmpty))
    szKeyValue = "Yes"
    lRes = RegSetValueExString(hKey, "UserCommitSync", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    lKeyValue = 2048
    lRes = RegSetValueExLong(hKey, "MaxBufferSize", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lKeyValue = 5
    lRes = RegSetValueExLong(hKey, "PageTimeout", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lKeyValue = 3
    lRes = RegSetValueExLong(hKey, "Threads", 0&, REG_DWORD, _
    lKeyValue, 4)
   
    lRes = RegCloseKey(hKey)
    lRes = RegCreateKey(HKEY_LOCAL_MACHINE, _
    "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", _
    hKey)
   


    If lRes <> ERROR_SUCCESS Then
        createAccessDSN = False
        Exit Function
    End If
   
    szKeyValue = "Microsoft Access Driver (*.mdb)"
    lRes = RegSetValueExString(hKey, szWantedDSN, 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
   
    lRes = RegCloseKey(hKey)
    createAccessDSN = True
End Function
'anywhere in application

Dim szDriverName As String
Dim szWantedDSN As String

szDriverName = String(255, Chr(32))
szWantedDSN = "MyAccess_ODBC"
'is access drivers installed?


If Not checkAccessDriver(szDriverName) Then
    MsgBox "You must Install Access ODBC Drivers before use this program.", vbOK + vbCritical
End If

'is our dsn exist?


If Not (checkWantedAccessDSN(szWantedDSN)) Then


    If szDriverName = "" Then
        MsgBox "Can't find access ODBC driver.", vbOK + vbCritical
    Else


        If Not createAccessDSN(szDriverName, szWantedDSN) Then
            MsgBox "Can't create database ODBC.", vbOK + vbCritical
        End If
    End If
End If


            
0
Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

 
LVL 2

Expert Comment

by:Microsoft
ID: 6164707
OOOOPS SORRY HAD PROBLEMS SUBMITTING,

DOES THAT CODE Help any

0
 
LVL 5

Expert Comment

by:AndrewDev
ID: 6164786
This code creates a system DSN, some small changes should allow you to create a user DSN

http://www.freevbcode.com/ShowCode.Asp?ID=502

Incidentally why do you need to create a user DSN. It sounds to me as if this is a good use for a DSNless connection as in this example:

http://www.freevbcode.com/ShowCode.Asp?ID=1257

Good Luck
Andrew
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6165331
0
 
LVL 2

Expert Comment

by:TravisHall
ID: 6165701
You might want to create a DSN (either system or user) in your setup program (using something like the code others have provided) - a good option if you just want to avoid the hassle of setting up the DSN, but want to retain the flexibility of having one. You could use a DSN-less connection (as suggested by Andrew) - generally a more sensible idea than having your actual program create a DSN on the fly.

However, if your app is going to be installed within your own organisation, on a number of machines on a LAN, another option is to use a file DSN located on a network share on a server. Your setup program can install a registry entry that the program reads to find out where to look for the file DSN. Then, every machine in the place is working from the same DSN, and if your database changes - say, your server goes belly-up and you have to restore your database to a different server - you just change the one file, and you're good to go.
0
 
LVL 9

Expert Comment

by:Valliappan AN
ID: 6166275
ping..
0
 
LVL 1

Expert Comment

by:wongchun
ID: 6166580
' For Setup ODBC DSN
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

Public Sub CreateSQLODBCSysDSN(ByVal DSN_Name As String, ByVal SQLServerName As String, Optional ByVal DefaultDatabase As String, Optional ByVal NTLogin As Boolean)
    Dim lngRet As Long
    Dim strAttributes As String
    Dim DefaultDB As String
   
    ' Default Database parameter checking
    If Trim(DefaultDatabase) = "" Then
        DefaultDB = "master"
    Else
        DefaultDB = DefaultDatabase
    End If
   
    'Set the detail of DSN
    strAttributes = "Dsn=" & DSN_Name & Chr$(0) & "Server=" & SQLServerName & Chr$(0) & "Database=" & DefaultDB & Chr$(0)
   
    ' True - NT Authentication; False - SQL Server Authentication
    If NTLogin Then
        strAttributes = strAttributes & "Trusted_Connection=Yes" & Chr(0)
    Else
        strAttributes = strAttributes & "Trusted_Connection=No" & Chr(0)
    End If

    'Create DSN
    '0& = Null, 4 = Add a System DataSource
    lngRet = SQLConfigDataSource(0&, 4, "SQL Server", strAttributes)
   
    If lngRet = 0 Then
        Err.Raise 32730, , "Cannot create ODBC system DSN " & DSN_Name & " for SQL Server " & SQLServerName
    End If
End Sub
0
 
LVL 1

Expert Comment

by:wongchun
ID: 6166587
Public Sub RemoveSysDSN(ByVal DSN_Name As String)
    Dim lngRet As Long
    Dim strAttributes As String
    Dim DefaultDB As String
   
    'Set the detail of DSN
    strAttributes = "Dsn=" & DSN_Name & Chr$(0)
    ' Remove DSN
    ' 0& = Null, 6 = Remove a System DataSource
    lngRet = SQLConfigDataSource(0&, 6, "SQL Server", strAttributes)
   
    If lngRet = 0 Then
        Err.Raise 32731, , "Cannot remove ODBC system DSN " & DSN_Name
    End If
End Sub
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
VBA saving file message display 5 63
Paint/Redraw window while dragging 16 75
Saving history changes to sub form 4 42
MS Access 03, TransferText, decimal places 8 68
Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

808 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question