Retrieve DB2 data from Excel
In order to get DB2 data from Excel you have to create a passthrough query in Access. For this project I created a Userform to retrieve my uid and password Save the Access file with in the same folder of your Excel file. Try something like this:
Option Explicit
Option Base 1
Sub Set_PltCode_and_Run_Query()
'
Dim DB1 As Database
Dim QRY1 As QueryDef
Dim RS1 As Recordset
Dim QueryString As String
Dim PltCode As String
Dim ConnStr As String
Dim Uid As String
Dim Pw As String
Dim Array1 As Variant
Dim x As Long
On Error GoTo ErrorHandler
With UserForm1
.Show
If UserForm1.Tag = vbOK Then
PltCode = .TextBox1.Text
Uid = .TextBox2.Text
Pw = .TextBox3.Text
End If
End With
'Define query string using the plant code requested.
QueryString = "SELECT DISTINCT A.I_ASSET, A.C_PROJ_LOC, .....
"......_PROJ_LOC = '" & PltCode & "' ORDER BY " & _
"A.I_ASSET"
ConnStr = "ODBC;DSN=xxxxxx;UID=" & Uid & ";PWD=" & Pw & ";LONGDATACOMPAT=1;" & _
"TABLETYPE='TABLE','ALIAS','VIEW','SYNONYM','INOPERATIVE VIEW';DBALIAS=xxxxxxx;PATCH1=12;"
' Open Access, modify query and retrieve records
Set DB1 = OpenDatabase(ThisWorkbook.Path & "\PM&C Data.MDB")
Set QRY1 = DB1.QueryDefs("qJoin_Proj")
QRY1.Sql = QueryString
QRY1.Connect = ConnStr
Set RS1 = DB1.OpenRecordset(Name:="qJoin_Proj", _
Type:=dbOpenDynaset)
' Count number of records
With RS1
.MoveLast
x = .RecordCount
.MoveFirst
End With
Array1 = RS1.GetRows(x)
'Paste records to the worksheet
Sheets("XXXXX").Select
Range("A2:H" & x + 1).Value = Application.Transpose(Array1)
ErrorHandler:
This_Module_Error_Routine
End Sub
Function This_Module_Error_Routine()
Dim dbError As Error
' If dbError = "Nothing" Then
' MsgBox ("There is not enough data in selected the date range to make a report")
' Exit Function
' End If
With dbengine
For Each dbError In .Errors
MsgBox "Error with object: " & dbError.Source & _
Chr(13) & dbError.Description
Next dbError
End With
End Function
