Query to DB2

C

cmdecker2

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
 
R

Rob van Gelder

.Refresh (BackgroundQuery = False)
should be
.Refresh BackgroundQuery := False

Then it will wait for the query to finish executing.

PS. This is the second time I've seen the same problem. Where did you get
the code from?
 
G

gocush

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top