ODBC DSN from visual Basic Code ?


  I want to create ODBC DSN through visual Basic Code at  
  run time.
  I want ODBC DSN through visual Basic Code for MS -
  Access and Oracle database.

  Thanks in advance.

Who is Participating?
cquinnConnect With a Mentor Commented:
A Microsoft  Class module to do just this:  (From NeatCD - a Microsoft Access database)

Option Explicit

' For an example that demonstrates the use of this class, please
' see the buildFileDSN procedure in the Call Neat Classes module.
' This class creates a File DSN ODBC datasource. It is currently
' designed for Microsoft SQL Server datasources only. The class has
' eight properties and one method to write the file. The driverName,
' serverName, and fileName properties are required. All others are
' optional. The optional properties can be set to an empty string
' as they are in the example, or they can be ommitted altogether. The
' default property value for the folder property is set by the class
' to the folder where File DSN files are normally stored. The class
' determines this location by querying the system registry. It is
' recommended that this not be changed by specifying an alternate
' folder unless you have a specific purpose for doing so. Additionally,
' the class uses an API call to determine the Workstation ID, so this
' function must be run on the machine where the FileDsn is to be used.

Private Declare Function GetComputerName Lib "kernel32" _
    Alias "GetComputerNameA" (ByVal lpbuffer As String, nsize As Long) As Long
Private 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
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
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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_NONE = 0

Private driver As String, uid As String, pwd As String, apath As String
Private app As String, server As String, fName As String, datBase As String

Private Sub Class_Initialize()  ' Initialize properties to 0 length string.
    driver = ""
    uid = ""
    pwd = ""
    app = ""
    server = ""
    datBase = ""
    apath = ""
End Sub

Property Let dataBaseName(argDataBaseName As String)
    datBase = argDataBaseName
End Property

Property Let drivername(argDriverName As String)
    driver = argDriverName
End Property

Property Let user(argUid As String)
    uid = argUid
End Property

Property Let password(argPwd As String)
    pwd = argPwd
End Property

Property Let clientApp(argClientApp As String)
    app = argClientApp
End Property

Property Let serverName(argServerName As String)
    server = argServerName
End Property

Property Let filename(argFilename As String)
    fName = argFilename
End Property

Public Property Let folder(ByVal vNewValue As Variant)
    apath = vNewValue
End Property
Sub writeFile()
    Dim theFile As Integer
    Dim filename As String
    Dim Default_Path
    Default_Path = getDSNDefault()
    If apath <> "" Then
        filename = apath & "\" & fName & ".dsn"
    ElseIf IsEmpty(Default_Path) Then
        filename = "C:\" & fName & ".dsn"
        MsgBox "Your file was written as: " & filename, vbInformation, "Default ODBC Directory Not Found"
        filename = Default_Path & "\" & fName & ".dsn"
    End If
    theFile = FreeFile
    On Error GoTo WriteFile_Err
    Open filename For Output As #theFile
        Print #theFile, "[ODBC]"
        Print #theFile, "DRIVER=" & driver
        If Len(uid) > 0 Then
            Print #theFile, "UID=" & uid
        End If
        If Len(pwd) > 0 Then
            Print #theFile, "PWD=" & pwd
        End If
        Print #theFile, "DATABASE=" & datBase
        Print #theFile, "WSID=" & getmachine()
        Print #theFile, "APP=" & app
        Print #theFile, "SERVER=" & server
        Close #theFile
    Close #theFile

If Err.Number = 76 Then
    MsgBox "Directory does not exist." & vbCrLf & "File was written to: C:\", vbInformation, "Invalid Path Specified"
    filename = "c:\" & fName & ".dsn"
End If
End Sub

Private Function getmachine()   ' Use API to get machine name (NT or WIN95).

    Dim length As Long
    Dim compname As String
    Dim returned
    length = 255
    compname = String$(255, 0)
    returned = GetComputerName(compname, length)
    If returned Then
        getmachine = left(compname, length)
        MsgBox "An error occured while retrieving the workstation id."
    End If

End Function
Private Function getDSNDefault() As Variant
       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
       Dim sKeyName As String
       Dim sValueName As String
       sKeyName = "software\odbc\odbc.ini\odbc file dsn"
       sValueName = "DefaultDSNDir"
       lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = QueryValueEx(hKey, sValueName, vValue)
       If lRetVal = ERROR_NONE Then
            getDSNDefault = left(vValue, Len(vValue) - 1)
            getDSNDefault = Empty
       RegCloseKey (hKey)
       End If
   End Function

Private 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
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5
    sValue = String(cch, 0)
    lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = left$(sValue, cch)
                vValue = Empty
            End If
    QueryValueEx = lrc
    Exit Function

    Resume QueryValueExExit
End Function
u can't create ODBC thr Vb (i haven't headr @ it)
puple can create odbc DSN using Administrative Tools and same DSN name can pass in string using adodb thru vb at runtime.
i don't think you can creat the DSN connection using vb code...wat you can do is you need to create the DSN connection in the ODBC, then only you can connect to the database using vb code on run time...
Train for your Pen Testing Engineer Certification

Enroll today in this bundle of courses to gain experience in the logistics of pen testing, Linux fundamentals, vulnerability assessments, detecting live systems, and more! This series, valued at $3,000, is free for Premium members, Team Accounts, and Qualified Experts.

Éric MoreauSenior .Net ConsultantCommented:
pretty easy! I do it really often. See this article: http://support.microsoft.com/default.aspx?scid=kb;EN-US;q184608
you can use DAO.DBEngine.RegisterDatabase method to create a DSN, but I like uld files better.

ADMINISTRATION WILL BE CONTACTING YOU SHORTLY.  Moderators Computer101, Netminder or Mindphaser will return to finalize these if they are still open in 7 days.  Experts, please post closing recommendations before that time.

Below are your open questions as of today.  Questions which have been inactive for 21 days or longer are considered to be abandoned and for those, your options are:
1. Accept a Comment As Answer (use the button next to the Expert's name).
2. Close the question if the information was not useful to you, but may help others. You must tell the participants why you wish to do this, and allow for Expert response.  This choice will include a refund to you, and will move this question to our PAQ (Previously Asked Question) database.  If you found information outside this question thread, please add it.
3. Ask Community Support to help split points between participating experts, or just comment here with details and we'll respond with the process.
4. Delete the question (if it has no potential value for others).
   --> Post comments for expert of your intention to delete and why
   --> YOU CANNOT DELETE A QUESTION with comments; special handling by a Moderator is required.

For special handling needs, please post a zero point question in the link below and include the URL (question QID/link) that it regards with details.
Please click this link for Help Desk, Guidelines/Member Agreement and the Question/Answer process.  http://www.experts-exchange.com/jsp/cmtyHelpDesk.jsp

Click you Member Profile to view your question history and please keep them updated. If you are a KnowledgePro user, use the Power Search option to find them.  

Questions which are LOCKED with a Proposed Answer but do not help you, should be rejected with comments added.  When you grade the question less than an A, please comment as to why.  This helps all involved, as well as others who may access this item in the future.  PLEASE DO NOT AWARD POINTS TO ME.

To view your open questions, please click the following link(s) and keep them all current with updates.

*****  E X P E R T S    P L E A S E  ******  Leave your closing recommendations.
If you are interested in the cleanup effort, please click this link
POINTS FOR EXPERTS awaiting comments are listed in the link below
Moderators will finalize this question if in @7 days Asker has not responded.  This will be moved to the PAQ (Previously Asked Questions) at zero points, deleted or awarded.
Thanks everyone.
Moderator @ Experts Exchange
Éric MoreauSenior .Net ConsultantCommented:
points to me.
dashishAuthor Commented:
Thanks for your valuable suggestions.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.