How to links table created in Ms Access using VB?

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
LVL 2
kunghui80Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

inthedarkCommented:
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
inthedarkCommented:
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
inthedarkCommented:
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
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

inthedarkCommented:
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
inthedarkCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
kunghui80Author Commented:
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
inthedarkCommented:
Woops in my last post I made a typo...change:

Set Tables = LanADO.GetTables(LanCN, ltReturnCollection)

To:

Set Tables = ADO.GetTables(CN, ltReturnCollection)

0
kunghui80Author Commented:
Hi inthedark,

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

Regards,
kelvin
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

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.