Execute DB2 Query & Export result in xls files
StringQ=""
wrkbkPath=""
SheetName=""
Dim con,rs
Set con=CreateObject("ADODB.Connection")
Set rs=CreateObject("ADODB.recordset")
Dim PathConfigFile,objxl,objWrkBk,objDB
Dim DBDriver,DBDatabase,DBHostname,DBPort,DBProtocol,DBProvider,DBUID,DBPwd
DBProvider="IBMDADB2"
DBDriver="{IBM DB2 ODBC DRIVER}"
DBHostname=""
DBDatabase=""
DBPort=50000
DBProtocol="TCPIP"
DBUID=""
DBPwd=""
con.connectionString="DRIVER=" & DBDriver & ";Database=" & DBDatabase&" ;Hostname=" & DBHostname & ";Port=" & DBPort & "; Protocol=TCPIP;Uid=" & DBUID & ";Pwd=" & DBPwd
con.Provider = DBProvider
con.Open
Con.CommandTimeout = 3600
rs.open StringQ,con
'Release the file object
Set objxl = CreateObject("Excel.Application")
Set objWrkBk=objxl.Workbooks.open(wrkbkPath)
Set objDB=objxl.ActiveWorkbook.worksheets(SheetName)
Dim objDB_rowCount
objDB_rowCount=objDB.usedrange.rows.count
If Execute_Query_DB2_Custom_Row ="False" Then
objDB.usedrange.EntireRow.delete
end if
'Loop and store them in the file
Dim counter
Do until rs.EOF
counter=counter+1
Dim var
For var=0 to rs.fields.count-1
If counter=1 Then
If Execute_Query_DB2_Custom_Row ="False" Then
objDB.cells(counter,var+1)=rs.fields(var).name
objDB.cells(counter+1,var+1)="'"&rs.fields(var).value
else
counter=objDB_rowCount-1+counter
If counter=1 Then
objDB.cells(counter,var+1)=rs.fields(var).name
end If
objDB.cells(counter+1,var+1)="'"&rs.fields(var).value
end If
else
objDB.cells(counter+1,var+1)="'"&rs.fields(var).value
End If
Next
rs.MoveNext
Loop
con.Close
objxl.ActiveWorkBook.save
objWrkBk.close
Set objDB=Nothing
Set objWrkBk=Nothing
Set objxl=Nothing
wrkbkPath=""
SheetName=""
Dim con,rs
Set con=CreateObject("ADODB.Connection")
Set rs=CreateObject("ADODB.recordset")
Dim PathConfigFile,objxl,objWrkBk,objDB
Dim DBDriver,DBDatabase,DBHostname,DBPort,DBProtocol,DBProvider,DBUID,DBPwd
DBProvider="IBMDADB2"
DBDriver="{IBM DB2 ODBC DRIVER}"
DBHostname=""
DBDatabase=""
DBPort=50000
DBProtocol="TCPIP"
DBUID=""
DBPwd=""
con.connectionString="DRIVER=" & DBDriver & ";Database=" & DBDatabase&" ;Hostname=" & DBHostname & ";Port=" & DBPort & "; Protocol=TCPIP;Uid=" & DBUID & ";Pwd=" & DBPwd
con.Provider = DBProvider
con.Open
Con.CommandTimeout = 3600
rs.open StringQ,con
'Release the file object
Set objxl = CreateObject("Excel.Application")
Set objWrkBk=objxl.Workbooks.open(wrkbkPath)
Set objDB=objxl.ActiveWorkbook.worksheets(SheetName)
Dim objDB_rowCount
objDB_rowCount=objDB.usedrange.rows.count
If Execute_Query_DB2_Custom_Row ="False" Then
objDB.usedrange.EntireRow.delete
end if
'Loop and store them in the file
Dim counter
Do until rs.EOF
counter=counter+1
Dim var
For var=0 to rs.fields.count-1
If counter=1 Then
If Execute_Query_DB2_Custom_Row ="False" Then
objDB.cells(counter,var+1)=rs.fields(var).name
objDB.cells(counter+1,var+1)="'"&rs.fields(var).value
else
counter=objDB_rowCount-1+counter
If counter=1 Then
objDB.cells(counter,var+1)=rs.fields(var).name
end If
objDB.cells(counter+1,var+1)="'"&rs.fields(var).value
end If
else
objDB.cells(counter+1,var+1)="'"&rs.fields(var).value
End If
Next
rs.MoveNext
Loop
con.Close
objxl.ActiveWorkBook.save
objWrkBk.close
Set objDB=Nothing
Set objWrkBk=Nothing
Set objxl=Nothing
Comments
Post a Comment