accessing an ODBC datasource via VBA

RoelSimons
RoelSimons used Ask the Experts™
on
A rather straight-forward question:

Below is a copy of the VBA module of an Excel file. In order not to miss any information, I copied the entire module:

Option Explicit
Global StrQuery As String
Global ObjCon As New ADODB.Command
Global RstMain As New ADODB.Recordset
Global ObjCnn As New ADODB.Connection
Global V_User_Id, V_Password, V_Start_Date, V_End_Date As String

Sub UF_Identfy_Show()
    UF_Identify.Show
End Sub

Public Function GetData() As ADODB.Recordset

    Set GetData = ReadDB2()
    Worksheets("Query Result").Activate
    Call DumpRecordset
    ObjCnn.Close
   
End Function

Public Function ReadDB2() As ADODB.Recordset
    On Error GoTo ErrorHandel
    ObjCnn.ConnectionString = "DSN=RDB2I;User ID=" & V_User_Id & ";PWD=" & V_Password & ";"
    ObjCnn.ConnectionTimeout = 600
    ObjCnn.CursorLocation = adUseClient
    ObjCnn.Open
    ObjCon.ActiveConnection = ObjCnn
    ObjCon.CommandTimeout = 600
    ObjCon.CommandText = StrQuery
    RstMain.CursorType = adOpenDynamic
    RstMain.CursorLocation = adUseClient
    RstMain.LockType = adLockOptimistic
    RstMain.MaxRecords = 64000
    RstMain.Open ObjCon
    Set ReadDB2 = RstMain
    Exit Function
ErrorHandel:
    MsgBox "Error in ReadDB2(), " & Err.Description & ""
    End
End Function

Public Sub DumpRecordset()

    On Error GoTo ErrorHandel
    On Error Resume Next
    Dim objField As Variant
    Dim i        As Integer
    Dim j        As Integer
    i = 1
    Do While Not RstMain.EOF
       i = i + 1
       j = 0
       Cells(i, j) = i - 1
       For Each objField In RstMain.Fields
           j = j + 1
           If IsNull(objField) Then
               Cells(i, j) = "."
           ElseIf objField.Type = adNumeric Then
               Cells(i, j) = CDbl(objField)
           Else
              Cells(i, j) = objField.Value
           End If
       Next
       RstMain.MoveNext
    Loop
    Exit Sub
ErrorHandel:
    MsgBox "Error in DumpRecordset(), " & Err.Description
    End
End Sub

Private Sub CB_OK_Click()

Dim str_Query As String
Dim str_New_Query As String
Dim int_Length As Integer
Dim i As Integer
Dim str_Char As String

V_User_Id = TB_User_Id.Text
V_Password = TB_Password.Text

str_Query = Me.txt_UserQuery.Text
int_Length = Len(str_Query)
str_Char = ""

For i = 1 To int_Length
    If Mid(str_Query, i, 2) = vbCrLf Then
    str_Char = str_Char & " "
    i = i + 1
    Else: str_Char = str_Char & Mid(str_Query, i, 1)
    End If
   
Next i
StrQuery = str_Char

Call GetData

Worksheets("query result").Activate

End Sub


As you can see, this module creates a link to an existing ODBC-datasourec. The V_userID, V_password variables and the query string StrQuery are provided by the user via a separate sheet (code not listed). The query result is stored in a recordset that is then 'dumped' on an Excel sheet.

I'm looking for a way to get the same link in access. More specifically, I would like to open a recordset in Access (RstMain) based on a query provided by a user, retrieve the query results in a recordset and add them to an existing Access table (so,an automatic 'update' of an existing Access table with external data).
I already tried a simple paste of the code above, but this doesn't work (as I had expected). I'm using Access 97, so maybe a different syntax is required for the connection? I think there's some work to do on the private/public functions and subs as well... the purpose is to have a 'connect' module that delivers a recordset, and an 'update' module that accesses the recordset and performs operations on the records.

Who could help me in rewriting this code so I'm able to get the data from the SAME datasource? I'm looking for a VBA solution, not a simple table link to an external source...

Because this would help me considerably, I'm awarding many points (given my current allowance).
But of course, any help is just welcome as it is...
If I can have a complete solution, meaning a working procedure to access the data source and retrieving the query data, and a procedure to put the query results in a recordset that I can use to update a table, I will even raise the points.

Thanks in advance,

Roel Simons
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2006

Commented:
instead of your looping dump you could use copyfromrecordset which is much faster

for your question specifics

title : Import data from Access to Excel (ADO)
source : http://edc.bizhosting.com/english/adodao.htm

Sub ADOFromAccessToExcel(DBFullName As String, TableName As String, _
    FieldName As String, TargetRange As Range)
' Example: ADOFromAccessToExcel "C:\FolderName\DataBaseName.mdb", "TableName", _
    "FieldName", Range("B1")
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim lngRowIndex As Long
    Set TargetRange = TargetRange.Cells(1, 1)
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
    Set rs = New ADODB.Recordset
    With rs
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
        .Open TableName, cn, , , adCmdTable ' all records
        '.Open "SELECT * FROM " & TableName & " WHERE " & FieldName & " = 'MyCriteria'", cn, , , adCmdText ' filter records
        If Not .BOF Then .MoveFirst
        lngRowIndex = 0
        While Not .EOF
            TargetRange.Offset(lngRowIndex, 0).Formula = .Fields(FieldName)
            lngRowIndex = lngRowIndex + 1
            .MoveNext
        Wend
    End With
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

instead of the         '.Open "SELECT * FROM " & TableName & " WHERE " & FieldName & " = 'MyCriteria'", cn, , , adCmdText ' filter records

you can always put in your query name there in the open method

hope this helps a bit

Author

Commented:
Actually, I don't need a link from Access into Excel; I would like to access a datasource outside Access (a DB2 tablespace).
The code I copied is the code that establishes the link from Excel to that DB2 datasource. I would like to do the same, but from Access. The problem is that this code doesn't work if I copy it into an Access VBA module. I'm looking for a way to create the same link, but now in Access...

Thanks already for your quick reply...
Top Expert 2006

Commented:
then i misread this question totally
JavaScript Best Practices

Save hours in development time and avoid common mistakes by learning the best practices to use for JavaScript.

Author

Commented:
my mistake. the explanation is a bit confusing...

Commented:
Here is code I use to dsn-less link using ODBC tables.  Would be a simple matter to include append queries to take data frm the linked tables and place iin in your Access ones.  TThis was written for Acess 97, using DAO

Option Compare Database
Option Explicit

Global db As Database

Global gintLinkExData As Integer   ' 1=Production, 2=Dev

Public Sub LinkTables()
Dim strConnect1 As String
Dim tbl01 As TableDef

    Set db = CurrentDb
   
' Create the Tables Def(s)
    Set tbl01 = db.CreateTableDef("xxxxx")    ' Target table name (Alias) Note the change of a period (.) to the underscore (_)
   
' Do The Connection
    tbl01.Connect = GetConnectString

' Set the Source
    tbl01.SourceTableName = "xxxxxx" ' Source Table Name
   
'Append the Table Def(s) to the Database
    db.TableDefs.Append tbl01
   
    DoCmd.Beep  ' Ping!
    MsgBox "Table Attachment(s) Completed", vbExclamation, "Attach Table(s) to XXXXXXXXX"
 
End Sub
Public Sub PingDatabase()   ' Ping the back end so that the application caches the connect string and won't ask again.

    Set db = OpenDatabase("", False, True, GetConnectString)
    DoCmd.Beep  ' Ping!
   
End Sub
Public Function GetConnectString() As String   ' Connection string utilizing a DSN-less connection

    If gintLinkExData = 1 Then      ' We are linking to Production
        GetConnectString = "ODBC;Driver={SQL Server};Server=Proxxx;Database=xxxx;UID=xxx;pwd=xxx;network=dbmssocn"
    ElseIf gintLinkExData = 2 Then  ' We are linking to Dev
        GetConnectString = "ODBC;Driver={SQL Server};Server=Devxxx;Database=xxx;UID=xxx;pwd=xxx;network=dbmssocn"
    End If
   
End Function


You will notice it has the ability to toggle betweeen two sources, kind of handy

Author

Commented:
This is already nice, but the thing is that Access application should be able to pass on complete query strings (tables included) to the DB2 mainframe environment. These query strings could be based on user-input (a 'query panel') or could be hard-coded. Example:

Function ReadDB2() As ADODB.Recordset
...
    V_User_Id = "ABCDEF"
    V_Password = "********"
    StrQuery = "select distinct mtr_inr_pro_dt from T.mi_mtr_inr_01c"
   
    ObjCnn.ConnectionString = "DSN=RDB2I;User ID=" & V_User_Id & ";PWD=" & V_Password & ";"
    ObjCnn.ConnectionTimeout = 600
    ObjCnn.CursorLocation = adUseClient
    ObjCnn.Open
    ObjCon.ActiveConnection = ObjCnn
    ObjCon.CommandTimeout = 600
    ObjCon.CommandText = StrQuery
    RstMain.CursorType = adOpenDynamic
    RstMain.CursorLocation = adUseClient
    RstMain.LockType = adLockOptimistic
    RstMain.MaxRecords = 64000
    RstMain.Open ObjCon
    Set ReadDB2 = RstMain
    Exit Function
...
End Function

I'm really not an expert in this matter, but I would like to keep the link via a DSN.
I'm just wondering what could be wrong with the code above? It should result in a recordset RstMain containing the records from the query result, shouldn't it? Or is this not the correct syntax in an Access 97 environment (should it be via DAO?)

Questions, questions, questions, ...

Commented:
Gottcha.

Maybe I am missing something, but is RST a module level or dlobal level variable?

Author

Commented:
I seems like it's a global variable (see the first mail for the Excel VBA code), but you can define it as you see fit.
I would just like to end up with a piece of code that enables me to get the access to the DB2-datasource (it works fine with Excel, so I don't think there are additional security issues...), and to get the query result in an editable recordset.

That would be my Holy Grail...

(I'll gladly spend an additional 150 points that I have left on my account if it works)

Commented:
Well, all the code makes sense, but at the end, you are setting
ReadDB2=RstMain
where is RstMain?  Uusllay, it would be like this (or something similar)
ReadDB2=RstMain ("SQL String")

Author

Commented:
In my first mail, you will see that RstMain is defined as a global ADODB.recordset variable.

Let me put it this way: how would you write the code for, let's say an OKButton_Click event for a form where a user has put his UserID, Password and SQL string? Upon clicking, the code should connect via the connection string that I specified in the first mail, pass the query on to the DB2 engine, and store the query result in a recordset, call it RstMain...

Commented:
Well, you want the user to enter from text boxes his UserID, Password and SQL string.
You have that already.  
I am assuming V_User_Id and V_Password  is a text box on this form
ObjCnn.ConnectionString = "DSN=RDB2I;User ID=" & V_User_Id & ";PWD=" & V_Password & ";"

and the recordset is created, so I am not sure where the problem is.  The only thing I do not see is the SQL for the recordset

Author

Commented:
Take a look at this piece of code:

Option Explicit
Dim StrQuery As String
Dim ObjCon As New ADODB.Command
Dim RstMain As New ADODB.Recordset
Dim ObjCnn As New ADODB.Connection
Dim V_User_Id, V_Password, V_Start_Date, V_End_Date As String

Private Sub Command2_Click()

    V_User_Id = "EMTRSR"
    V_Password = "********"
    StrQuery = "select distinct mtr_inr_pro_dt from T.mi_mtr_inr_01c"
   
    ObjCnn.ConnectionString = "DSN=RDB2I;User ID=" & V_User_Id & ";PWD=" & V_Password & ";"
    ObjCnn.ConnectionTimeout = 600
    ObjCnn.CursorLocation = adUseClient
    ObjCnn.Open
    ObjCon.ActiveConnection = ObjCnn
    ObjCon.CommandTimeout = 600
    ObjCon.CommandText = StrQuery
    RstMain.CursorType = adOpenDynamic
    RstMain.CursorLocation = adUseClient
    RstMain.LockType = adLockOptimistic
    RstMain.MaxRecords = 64000
    RstMain.Open ObjCon
   
End Sub

If a click the Button, I get the error: User-defined type not defined.
How can I correct this and how could I for instance put the first field of the first record of the recordset in a Msgbox?
 
Where in the code do you get the error? Which line does it stop on?

As for the messagebox -

MsgBox RstMain.Fields("mtr_inr_pro_dt")

Joe

Commented:
Now we are getting to the meat!

Where is the eror occurring?

getting the first record to a msgbox is not a problem

rst.movefirst
msgbox rst.(0)

Commented:
Morning, Joe!  :)

Author

Commented:
It doesn't even enter the actual code. The full error message is: "The expression On Click you entered as the event property setting produced the following error: User-defined type not defined.

Would it help if I send you the DB (it's a testDB: the only object is 1 form with 1 button and the code behind the Click_event)?

The least you can say is that will have totally earned your points if you can pull it off...

Commented:
Well, for me to test I would also have to have the db you are connecting to.

did you compile the code?  Try that.

Author

Commented:
All right, the 7th cavalry is growing in strenght!

This the only code in the form module of my DB:

Option Compare Database
Option Explicit
Dim StrQuery As String
Dim ObjCon As New ADODB.Command
Dim RstMain As New ADODB.Recordset
Dim ObjCnn As New ADODB.Connection
Dim V_User_Id, V_Password, V_Start_Date, V_End_Date As String

Private Sub Command2_Click()

    V_User_Id = "EMTRSR"
    V_Password = "********"
    StrQuery = "select distinct mtr_inr_pro_dt from T.mi_mtr_inr_01c"
   
    ObjCnn.ConnectionString = "DSN=RDB2I;User ID=" & V_User_Id & ";PWD=" & V_Password & ";"
    ObjCnn.ConnectionTimeout = 600
    ObjCnn.CursorLocation = adUseClient
    ObjCnn.Open
    ObjCon.ActiveConnection = ObjCnn
    ObjCon.CommandTimeout = 600
    ObjCon.CommandText = StrQuery
    RstMain.CursorType = adOpenDynamic
    RstMain.CursorLocation = adUseClient
    RstMain.LockType = adLockOptimistic
    RstMain.MaxRecords = 64000
    RstMain.Open ObjCon
    MsgBox RstMain.Fields("mtr_inr_pro_dt")

End Sub

Commented:
If you put a breakpoint in, it never gets there.
You complied the code, no errors.
You get the error when it runs, correct?

Author

Commented:
No, if I run the above, I now get the error message:

Compile error: User-defined type not defined.
Upon clicking OK, the yellow arrow points to the first line: Private Sub Command0_Click()
and the following is highlighted: ObjCon As New ADODB.Command
Commented:
K, I just test the code and it compiles.  What version of Access? (97 I bet)
While in the code, go to tools---references, do you have Microsoft Active Data Objects 2.7 Library checked? (or higher than 2,7)

Author

Commented:
The Eagle has landed! One small step...

Actually, nothing was checked; the highest available in the list is 2.5, but this one works!!!

This is really great, thanks a million.
Like I said, it is what I need, so I'm raising the reward to 450...

And my eternal gratitude of course, which is priceless.

Best regards,

Roel

Commented:
Glad I was able to help...  Nice it was not a real code problem rather a configuration.  Hint... when someone gives you code that they swer works and it does not compile, immediately thin 'References', 99% of the time, that does it.
Good morning 1William!

I figured it was a reference problem. Success!

Joe

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial