Solved

How to links table created in Ms Access using VB?

Posted on 2004-10-21
213 Views
Last Modified: 2012-08-13
Hello,

I have some problems here. How to SELECT & OPEN tables created in MS Access using VB? Is it possible to be done? I've created 3 tables in MS Access, and now I wish to create a VB application to SELECT and OPEN the certain tables through VB application to retrieve the information. How to link/connect both together?

Everytime if i create a new table in same Ms Access file, the VB program will auto detect and add to the new list. Which meant VB has to open the Access file, retrieve all the available tables in the file and shown in VB application. Users can select which tables to open in VB environment.

Can anyone provide me some coding on how to implement this?
I'm also a bit doubt whether this is a logic question, wish experts here could assist me in this. Many thanks!

Best regards,
Kelvin Tiong
0
Question by:kunghui80
    8 Comments
     
    LVL 17

    Expert Comment

    by:inthedark
    Do you want to use ADO(Newest) or DAO (older and simpler)?

    1) First you need to install the latest version of MDAC (2.8 for XP or 2.71) from:

    www.microsoft.com/data.

    2) Then you need to connect to your data.  First you need to create a UDL file to create a connection string.

    3) Now you need a connection to your database:

    Set a reference in your project to ActiveX Data Objects V2.x

    Dim CN as ADODB.Connection
    St CN = New ADODB.Connection
    CN.ConnectionString = "....." ' look in your UDL file for the connection details

    4) Now you are connected you can get your dat:

    Dim SQL as String
    Dim RS As ADODB.RecordSet

    Set RS = New ADODB.Recordset

    SQL = "Select * from [your table];
    RS.Open SQL,CN

    5) You can use a recordset to get table info using OpenSchema.

    I have some functions which makes life real easy.


    0
     
    LVL 17

    Expert Comment

    by:inthedark
    a) Here are the MDAC downloads:

    http://msdn.microsoft.com/data/downloads/updates/default.aspx#MDAC

    b) Here is the Microsoft info on how to create a UDL (Universal Data Locator) to get a connection string.

    http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnima00/html/ima0086.asp

    If you're a cute programmer you can open the UDL file and get the string with code.  So save you UDL file in your app path.

    l = freefile
    Open App.Path & "\Data.UDL" for input shared as #l
    I will post more code for this later.

    In this way you can change your data location, or swap to SQL server, without recompile of the software.










    0
     
    LVL 17

    Expert Comment

    by:inthedark
    Some handy functions:

    ===========Open a connection
    Example:
    Dim CN as ADODB.Connection
    Dim OK
    Dim ConnectionString As String
    ConnectionString="......."
    OK=ConnectODBCOK(CN, ConnectionString)

    Public Function ConnectODBCOK(CN As ADODB.Connection, ODBCString As String) As Boolean

    ' Open a connection
    ' return OK status = True or False
       
    AutoHoldConnection = False
    If AutoHoldConnection Then
        If Not SavedCN Is Nothing Then
            Set CN = SavedCN
            ConnectODBCOK = True
            Exit Function
        End If
    End If

    Set CN = New ADODB.Connection
    On Error Resume Next
    Err = 0
    CN.ConnectionString = ODBCString
    CN.CommandTimeout = 1200
    If IDE() Then
        CN.ConnectionTimeout = 20
        On Error GoTo 0
    Else
        CN.ConnectionTimeout = 45
    End If
    Err.Clear
    CN.Open
    DBTypeFound = False
    mdbName = ""
    If Err.Number <> 0 Then
        ErrN = Err.Number
        ErrD = Err.Description
        ConnectODBCOK = False
    Else
        ConnectODBCOK = True
        mCN = UCase(CStr(CN)) ' save connection info which you may need later
    End If

    End Function

    ===========Open a recordset
    Example:
        ' note use of cSQL to make sure no ' in string data
        SQL = " Select * from Customers where (Email = '" & cSQL(email) & "')"
        SQL = SQL + " Order By [name].[number] Desc;"
       
        ok = ADO.OpenRSROOK(CN, RS, SQL)
        If Not ok Then


    ' Don't forget to Add projet reference to MS ActiveX Data Objects
    Public Function OpenRSOK(CN As ADODB.Connection, RS As ADODB.Recordset, SQL As String, Optional CursorType As ADODB.CursorTypeEnum = adOpenForwardOnly, Optional LockType As LockTypeEnum = adLockReadOnly, Optional CommandType As ADODB.CommandTypeEnum = adCmdText, Optional CursorLocation As ADODB.CursorLocationEnum = adUseServer, Optional AppendOnly As Boolean = False) As Boolean

    ' Opens any type of recoordset return true is OK

    Set RS = New ADODB.Recordset

    On Error Resume Next
    Err.Clear

    RS.CursorLocation = CursorLocation
    If AppendOnly Then
        ' **** Warning only works with access
        ' but even then it don't work.
        RS.Properties("Append-Only Rowset") = True
    End If
    RS.Open SQL$, CN, CursorType, LockType, CommandType

    If Err.Number <> 0 Then
        Set RS = Nothing
        OpenRSOK = False
    Else
        OpenRSOK = True
    End If

    End Function

    ===========cSQL - Make sure no apostrophe are found in any strings
    Example:

    Public Function cSQL(ByRef SQLData) As String
    ' Convetrs single ' to double '' which is allowed.
    If IsNull(SQLData) Then
        cSQL = ""
    Else
        cSQL = Replace(CStr(SQLData), "'", "''")
    End If
    End Function

    ===========cSQL - Make sure no apostrophe are found in any strings
    Example:
    For example see comments within the function.

    Function GetTables(CN As ADODB.Connection, Optional ReturnType As ListOptions = ltReturnCollection)
    '
    '
    'Dim LanADO As New zADO
    'Dim LanCN As ADODB.Connection
    'Dim Tables As Collection
    'Dim ADO
    'Dim OK
    '
    '' register your connection string
    'LanADO.RegisterUDLFile App.Path + "\Local\LANServer.udl"
    '
    '' connecto to the server
    'OK = LanADO.ConnectOK(LanCN)
    '
    '' get the tables
    'Set Tables = LanADO.GetTables(LanCN, ltReturnCollection)
    'Dim vTable
    'For Each vTable In Tables
    '    MsgBox vTable
    'Next


    ' Returns a string array of tables names
    ' or a list of names sep by vbCrLf

    Dim RS As ADODB.Recordset
    Dim tb$
    Dim Col As Collection
    Dim sSep As String

    If ReturnType = ListOptions.ltReturnListCRLF Then
        sSep = vbCrLf
    ElseIf ReturnType = ListOptions.ltReturnListSemiColon Then
        sSep = ";"
    End If
    Set Col = New Collection


    Set RS = CN.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "Table"))
    Dim fld As ADODB.Field
    Set fld = RS("TABLE_NAME")

    Do While Not RS.EOF
        If LCase(fld) <> "dtproperties" Then
            If ReturnType = ListOptions.ltReturnCollection Then
                Col.Add CStr(fld)
            ElseIf Len(tb$) > 0 Then
                tb = tb + sSep + fld
            Else
                tb = fld
            End If
        End If
        RS.MoveNext
    Loop
    RS.Close

    Select Case ReturnType
        Case Is = ListOptions.ltReturnCollection
            Set GetTables = Col
        Case Is = ListOptions.ltReturnListSemiColon, ListOptions.ltReturnListCRLF
            GetTables = tb$
        Case Else
            GetTables = Split(tb$, vbCrLf)
    End Select

    End Function

    ' the above function needs this Enum
    Public Enum ListOptions
        ltReturnCollection      ' returns info as collection
        ltReturnListSemiColon   ' returns info like: item1;item2;item3
        ltReturnListCRLF        ' returns like a text file with Cr/Lf after each item
        ltReturnListCommas      ' like: item1,item2,item3 (Notavailable for GetTables)
        ltReturnArray           ' returns the list as an array
    End Enum



    0
     
    LVL 17

    Expert Comment

    by:inthedark
    Here is an example of how to get data from a UDL file. This is not so easy as a UDL file is saved in Unicode format:

    Public Sub RegisterUDLFile(psFileName As String, Optional psPassword As String = "")

    ' Use of this sub avoides the problem that of a connection file has been saved
    ' with extra lines at the end this will cause a crash.

    Dim sFile As String
    Dim GF As New zGF ' handy function library

    sFile = GF.ReadFile(psFileName) ' read the whole file

    sFile = StrConv(sFile, vbFromUnicode) ' convert from unicode
    sFile = Replace(sFile, "$$PASSWORD$-", psPassword) ' replace the password if there is one
    Dim lPos As Long
    lPos = InStr(1, sFile, "Provider=", vbTextCompare)
    If lPos > 0 Then
        sFile = Mid(sFile, lPos)
    End If

    ' save the connection string
    RegisterConnectString sFile

    End Sub

    Also needs this function:

    Public Function ReadFile(FileName As String) As String
    ErrN = 0
    ErrD = ""
    ' Reads a whole file into a string
    ' string contains ERROR if file not found or error

    Dim wlfn As Long

    wlfn = FreeFile
    On Error Resume Next

    If Len(Dir(FileName)) > 0 Then
       
        If Err.Number > 0 Then
            ReadFile = "ERROR:Invalid resource file path: " + FileName
            ErrN = Err.Number
            ErrD = Err.Description + ": " + FileName
            Exit Function
        End If
       
        Open FileName For Binary Access Read Shared As #wlfn
        Dim buf$
        buf$ = Space(LOF(wlfn))
        Get wlfn, 1, buf$
        Close wlfn
        ReadFile = buf
        Close wlfn
    Else
        ErrN = -1
        ErrD = "Missing file: " + FileName
           
        ReadFile = "ERROR"
    End If

    End Function



    0
     
    LVL 17

    Accepted Solution

    by:
    So in short I would put all of the above functions in a class say called zADO.cls.  When I want to open a database I declare the class in my form decs. or as a global.

    Dim ADO as New zADO

    Sub Form_Load()

    ' Get connection string from UDL file
    ADO.RegisterUDLFile App.Path & "Data.udl"

    ' Connect to data:
    OK=ADO.ConnectOK(CN) ' uses connection string saved by Register UDL

    ' get the tables:
    Dim Tables
    Dim vTable
    Set Tables = LanADO.GetTables(LanCN, ltReturnCollection)
    Dim vTable

    ' save each table into a list box
    For Each vTable In Tables
        List1.AddItem vTable
    Next
    CN.Close
    Set CN = Nothing
    End Sub

    Sub list1_DblClick()

    ' user doubles click on an item in a list box:
    Dim sTable As String

    sTable = List1.List(List1.ListIndex)

    ' Now lauch a new form to display the table data:

    Dim frm As frmMyTableForm
    Set frm = New frmMyTableForm
    ' pass the table name to public variable in te form
    frm.Table = sTable
    frm.Show

    End Sub

    ===============frmMyTableForm.frm
    Option Explicit
    Public Table As String

    Sub Form_Load()

    ' load the records from the table:

    ' Get connection string from UDL file
    ADO.RegisterUDLFile App.Path & "Data.udl"

    ' Connect to data:
    OK=ADO.ConnectOK(CN) ' uses connection string saved by Register UDL

    SQL = "Select * from [" + Table + "];"

    Dim RS As ADODB.Recordset
    OK=ADO.OpenRSOK(CN, RS, SQL)
    If Not OK Then
        msgbox "Cannot access table at present: " +Table
        Unload Me
        Exit Sub
    End If

    ' display the records
    Do While Not RS.EOF
        List1.Additem RS(0) ' or RS("MyField"), or like "" & RS(0) & " " & RS(1) to avoid problems with nulls
        RS.MoveNext
    Loop
    RS.Close
    CN.Close

    End Sub

    Hope this helps:~)
    0
     
    LVL 2

    Author Comment

    by:kunghui80
    Thanks for the answer given, it's long answer, give me some times to digest and try out. I will get back to you soon.

    Thanks so much for your time.

    Best regards,
    Kelvin
    0
     
    LVL 17

    Expert Comment

    by:inthedark
    Woops in my last post I made a typo...change:

    Set Tables = LanADO.GetTables(LanCN, ltReturnCollection)

    To:

    Set Tables = ADO.GetTables(CN, ltReturnCollection)

    0
     
    LVL 2

    Author Comment

    by:kunghui80
    Hi inthedark,

    thank you for the hints and source code. it helps me lots.

    Regards,
    kelvin
    0

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone. Privacy Policy Terms of Use

    Featured Post

    Highfive + Dolby Voice = No More Audio Complaints!

    Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

    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…
    If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
    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…
    Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

    860 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

    Need Help in Real-Time?

    Connect with top rated Experts

    13 Experts available now in Live!

    Get 1:1 Help Now