RE: Query to DB2

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance

From: gocush (gocushNOT_THIS_at_comcast.net/delete)
Date: 01/25/05


Date: Tue, 25 Jan 2005 00:15:02 -0800

I have been exploring the same question and have put together a workbook with
both Excel's built-in Query tables using Data>GetExtenalData and the vba
method using ADO language.
The code for the former was pretty easy to generate using the Recorder, so I
won't expand on that.
Since the ADO code took considerable sniffing around and piecing together, I
will post it here to give you (and maybe others) a bit of a shortcut. The
code includes several alternatives which are commented. I often do this when
developing so I can later modify as needed. Each commented alternative has
been tested and works so just select your preference and uncomment it. As
usual you will want to adapt this to your specific needs.
Hope this helps.

Option Explicit

Sub GetDataWithADO()

''''''''''''''''''''''''''
' Purpose: Extract data from a Database to Excel
' Setup: Excel Named Ranges: Field1 >> the upper left cell of the
extraction range
' dbName, dbPath, dbTable,
' FieldList >> a verticle list of fields from the db
' This allows the user to select a subset of
fields to extract
' Under development: An excel Criteria range which will allow the user to
enter
' criteria for the fields selected in the FieldList rng. The
Criteria range
' will be used to build the sql WHERE clause.

''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim Field As ADODB.Field
    Dim sProv As String, sDS As String, sCon As String, sTable As String,
sql As String
    
    Dim i As Integer, j As Integer, k As Integer
    Dim StartDate As Date, EndDate As Date
    
    Dim ExtractFields As Range, sFields As String
    Dim MSG As String
    
    
On Error GoTo ErrHndlr
    Sheets("ADO").Activate
    '''GET DATA SOURCE
    sProv = "Provider=Microsoft.Jet.OLEDB.4.0;" ' (MS ACCESS)
    sDS = "Data Source=" & Range("dbPath") & "\" & Range("dbName") & ";"
'Alternatives:
' sDS = "Data Source=" & ThisWorkbook.Path & "\dbTEST1.mdb;"
' sDS = "Data Source=J:\EXCEL FILES\MyDatabaseName.mdb;"

    sCon = "" & sProv & sDS & ""
    sTable = Range("dbTable") 'Name of Database Table
  
    '''GET DATE RANGES
    On Error Resume Next
    StartDate = Range("D12")
    EndDate = Range("E12")
    If Err > 0 Then
        MsgBox "The Date ranges are invalid. Check the data type.",
vbOKOnly, "ERROR: "
        Exit Sub
    End If
    On Error GoTo ErrHndlr
    
    '''CLEAR OLD FIELDS
    Range(Range("Field1"), Cells(Range("Field1").Row,
256).End(xlToLeft)).ClearContents
        
    '''GET FIELD STRING
    i = Application.CountA(Sheets("Sheet1").Range("FieldList"))
    Set ExtractFields = Range(Range("Field1"), Range("Field1").Offset(0, i -
1))
    ExtractFields = Application.Transpose(Sheets("Sheet1").Range("FieldList"))
    For j = 1 To i
        sFields = sFields & ", " & ExtractFields(j)
    Next j
    ''' get rid of the first ","
    sFields = Mid(sFields, 3)
     

     ''' CLEAR OLD DATA
    Sheets("ADO").Range("Field1").CurrentRegion.Offset(1, 0).Clear

    '''Create the SQL STRING
            ''' for DATE TYPE
    sql = "Select " & sFields & _
        " From " & sTable & _
        " WHERE (((DOB) Between #1/1/90# And #1/1/93#) AND
((Lname)Like""B%"") AND ((City)Like""S%""))"

'Alternatives for Date fields:
' sql = "Select " & sFields & _
        " From " & sTable & _
        " WHERE (((DOB) >= #1/1/90#))"
' sql = "Select " & sFields & _
        " From " & sTable & _
        " WHERE (((DOB) >= #" & Range("D12") & "#))"
' sql = "Select " & sFields & _
        " From " & sTable & _
        " WHERE (((DOB) Between #" & Range("D12") & "# And #" & Range("E12")
& "#))"
' sql = "Select " & sFields & _
        " From " & sTable & _
        " WHERE (((DOB) Between #" & StartDate & "# And #" & EndDate & "#))"
' sql = "Select " & sFields & _
        " From " & sTable & _
        " WHERE (((DOB) Between #1/1/90# And #1/1/93#))"
 
''''''''''''''''''''''''''''''''''''''''
'Alternatives FOR TEXT STRING fields
' sql = "Select " & sFields & _
        " From " & sTable & _
        " WHERE (((Lname)Like""B%""))"
' sql = "Select " & sFields & _
        " From " & sTable & _
        " WHERE (((Lname)=""Jones""))"
' sql = "Select " & sFields & _
        " From " & sTable & _
        " WHERE (((Lname) Between """ & First & """ And """ & Last & """))"
' sql = "Select " & sFields & _
        " From " & sTable & _
        " WHERE (((Lname) Between ""Ba"" And ""N""))"
      
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     ''' OPEN THE CONNECTION
    cn.Open sCon
    
    '''OPEN THE RECORDSET
    rs.CursorLocation = adUseClient
            'this allows the RecordCount property to work
            'when the db is on the client side
    rs.Open sql, cn
    
    
    '''COPY RECORDSET INTO XL RANGE
         ''First check to see if there is room
    If rs.RecordCount > 65400 Then 'adj as desired
        MSG = "The Number of Records Found: " & rs1.RecordCount & vbCrLf
        MSG = MSG & "Exceeds the limit of this worksheet."
        MsgBox MSG, vbOKOnly, "TOO MANY RECORDS: ADJUST THE SEARCH CRITERIA"
        Exit Sub
    End If
        ''Dump the recordset
    Sheets("ADO").Range("Field1").Offset(1, 0).CopyFromRecordset rs1
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    '''FORMAT DATE FIELDS - THESE DON'T DOWNLOAD IN DATE FORMAT
    k = 1
    For Each Field In rs.Fields
        If Field.Type = adDate Then
            ExtractFields(k).EntireColumn.NumberFormat = "mm/dd/yy"
        End If
        k = k + 1
    Next Field
        
''''''''''''''''''''''''''''''''''''''''''''''''
     
     ''' CLOSE

Tidy:
    Set cn = Nothing
    Set rs = Nothing
    Set ExtractFields = Nothing
    Set Field = Nothing
    
    Exit Sub
    
              
ErrHndlr:
    MsgBox "UNABLE TO COMPLETE THE SEARCH.", vbOKOnly, "ERROR:"
    GoTo Tidy
    
End Sub

"cmdecker2" wrote:

> What is the best coding and connection to run against a DB2 database?
> I can get something like to work but is it the best?
> I want to loop through many files and SQLs so I need the program to wait for
> the data to return before going to the next command.
>
> With ActiveSheet.QueryTables
> ..Add(Connection:=ConnectString, Destination:=Range(DataTarget), Sql:=mySQL)
> ..Refresh (BackgroundQuery = False)
> End With
> I am going against an ODBC to a DB2 database and I was not sure if I was
> doing this connection right or should I establish a an ADO connection use ,
> create a querry, and return a record set? Do I need an ADO? Not sure how, as
> I have seen some snipits of ADO, but not the whole thing so I am not sure
> how to put it togheter.
>
> The SQL works. ;)
>
> Confused
>
>
>
>
>
>
>



Relevant Pages

  • what type of code is this?
    ... but i need to read a csv file that contains information about different concerts and events... ... Dim Data As String ... I need to search within the group of csv files and extract data into an Excel ...
    (microsoft.public.excel.programming)
  • RE: ODBC query in VB code Need HELP
    ... Everything for ADO is in the first 2 messages that I gave you. ... Since your pass-through query already exists (including the ... Dim STRSQL As String ...
    (microsoft.public.access.formscoding)
  • Re: Problem adding record using ADO
    ... >>> Dim strDBPath As String ... >>> Dim strInsertSQL As String ... Also useful to add error handling and collect *ALL* of the ADO errors.... ...
    (microsoft.public.vb.database.ado)
  • Re: Insert date into a datetime column in Visual Basic 2008
    ... Dim conn As SqlConnection ... Dim cmdString As String ... system.datetime.tostring) into a datetime column using ADO. ... Are you using ADO or ADO.Net? ...
    (microsoft.public.data.ado)
  • Re: Luddites ! ; forward into the past ! (ADO/DAO)
    ... I am the harbinger of doom for those who continue to try to use traditional ADO with .NET. ... ' Dim Conn As New ADODB.Connection ... Dim sql As String ... Private Sub Button1_ClickHandles Button1.Click ...
    (microsoft.public.dotnet.framework.adonet)