Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

How to links table created in Ms Access using VB?

Posted on 2004-10-21
8
Medium Priority
?
216 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
Comment
Question by:kunghui80
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 2
8 Comments
 
LVL 17

Expert Comment

by:inthedark
ID: 12370871
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
ID: 12370933
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
ID: 12371135
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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 17

Expert Comment

by:inthedark
ID: 12371203
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:
inthedark earned 2000 total points
ID: 12371403
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
ID: 12377839
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
ID: 12378992
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
ID: 12470190
Hi inthedark,

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

Regards,
kelvin
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

604 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