M
michael.beckinsale
Hi All,
Bob - You were right the other post did not address this!
This is the process that is followed to populate an Excel MIS. The
user clicks a button in Excel to trigger it.
1) Financial database tables linked to Access, Access query to
retrieve required data, Access crosstab query to manipulate data to
required format, import crosstab data to Excel.
This is what l would like to do:
2) Financial database tables, query to multiple tables and retrieve
data into Excel, run sql crosstab query
on retrieved data in Excel.
I know how to download the financial tables using ADO & SQL (using the
code posted below, found by searching this newsgroup) but l cant seem
to get it to run a simple query on 1 table let alone over multiple
tables. So my questions re 2) are:
a) What is wrong with the SQL code below, which queries 1 table. Is it
my syntax? I am not an SQL expert.
b) Can you use SQL to query multiple tables from within the Excel VBA
environment.
c) I assume that the results of the intial query have to be written
to
an Excel sheet
d) Can l then use a SQL statement within VBA to create a sheet with
the results of the crosstab query?
e) If b) can be done does anybody have any example code please? or can
anybody tell me how to amend my existing code?
f) Will 2) be quicker / more efficient than 1)
I have been told by a database expert that because of the layout of
the tables within the financial database a single query cannot give
the desired result. I am not an expert on SQL.
I hope l have explained myself clearly.
All advice gratefully received.
Regards
Michael Beckinsale
CODE:
Option Explicit
Private Const glob_DBPath = "SageLine50v11"
Private Const glob_sConnect = "Provider=MSDASQL.1;Persist Security
Info=False;User ID=manager;Data Source=" & glob_DBPath & ";" '<-----
Note ID & Pasword may need changing
Private Sub RetrieveRecordset(strSQL As String, clTrgt As Range)
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: To retrieve a recordset from a database (via an SQL
query) and place
' it in the supplied worksheet range
'NOTE : Requires a reference to "Microsoft ActiveX Data
Objects 2.x Library"
' (Developed with reference to version 2.0 of the above)
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim rcArray As Variant
Dim lFields As Long
Dim lRecrds As Long
Dim lCol As Long
Dim lRow As Long
'Open connection to the database
cnt.Open glob_sConnect
'Open recordset based on Orders table????????????????
rst.Open strSQL, cnt
'Count the number of fields to place in the worksheet
lFields = rst.Fields.Count
'Check version of Excel
If Val(Mid(Application.Version, 1, InStr(1, Application.Version,
".") - 1)) > 8 Then
'EXCEL 2000 or 2002: Use CopyFromRecordset
'Copy the recordset from the database
On Error Resume Next
clTrgt.CopyFromRecordset rst
'CopyFromRecordset will fail if the recordset contains an OLE
'object field or array data such as hierarchical recordsets
If Err.Number <> 0 Then GoTo EarlyExit
Else
'EXCEL 97 or earlier: Use GetRows then copy array to Excel
'Copy recordset to an array
rcArray = rst.GetRows
'Determine number of records (adds 1 since 0 based array)
lRecrds = UBound(rcArray, 2) + 1
'Check the array for contents that are not valid when
'copying the array to an Excel worksheet
For lCol = 0 To lFields - 1
For lRow = 0 To lRecrds - 1
'Take care of Date fields
If IsDate(rcArray(lCol, lRow)) Then
rcArray(lCol, lRow) = Format(rcArray(lCol, lRow))
'Take care of OLE object fields or array fields
ElseIf IsArray(rcArray(lCol, lRow)) Then
rcArray(lCol, lRow) = "Array Field"
End If
Next lRow
Next lCol
'Transpose and place the array in the worksheet
clTrgt.Resize(lRecrds, lFields).Value = TransposeDim(rcArray)
End If
EarlyExit:
'Close and release the ADO objects
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
On Error GoTo 0
End Sub
Private Function TransposeDim(v As Variant) As Variant
'Function Purpose: Transpose a 0-based array (v)
Dim x As Long, Y As Long, Xupper As Long, Yupper As Long
Dim tempArray As Variant
Xupper = UBound(v, 2)
Yupper = UBound(v, 1)
ReDim tempArray(Xupper, Yupper)
For x = 0 To Xupper
For Y = 0 To Yupper
tempArray(x, Y) = v(Y, x)
Next Y
Next x
TransposeDim = tempArray
End Function
'The routine is called by code such as the following:
Sub GetRecords()
'Macro Purpose: To retrieve a recordset to an Excel worksheet
Dim sSQLQry As String
Dim rngTarget As Range
'WRITE THE SQL QUERY and assign to the variable
'....this example applies specifically to the named database
'....this example query works when connected to PaintballDB.mdb or
Sage Line 50
' sSQLQry = "SELECT NOMINAL_LEDGER.ACCOUNT_REF,
NOMINAL_LEDGER.NAME, " & _
' "NOMINAL_LEDGER.BALANCE FROM NOMINAL_LEDGER;"
'....end of example
'....this code wont work - why?
sSQLQry = "SELECT NOMINAL_LEDGER.NAME,
NOMINAL_LEDGER.ACCOUNT_REF" & _ "WHERE (NOMINAL_LEDGER.ACCOUNT_REF >
4000) FROM NOMINAL_LEDGER;"
'....end of code not working
'Set the Excel target range
'....................................................................................................
ActiveSheet.Cells.ClearContents 'may want to
change as it deletes header information
Set rngTarget = ActiveSheet.Range("A2")
'Retrieve the records
Call RetrieveRecordset(sSQLQry, rngTarget)
End Sub
Bob - You were right the other post did not address this!
This is the process that is followed to populate an Excel MIS. The
user clicks a button in Excel to trigger it.
1) Financial database tables linked to Access, Access query to
retrieve required data, Access crosstab query to manipulate data to
required format, import crosstab data to Excel.
This is what l would like to do:
2) Financial database tables, query to multiple tables and retrieve
data into Excel, run sql crosstab query
on retrieved data in Excel.
I know how to download the financial tables using ADO & SQL (using the
code posted below, found by searching this newsgroup) but l cant seem
to get it to run a simple query on 1 table let alone over multiple
tables. So my questions re 2) are:
a) What is wrong with the SQL code below, which queries 1 table. Is it
my syntax? I am not an SQL expert.
b) Can you use SQL to query multiple tables from within the Excel VBA
environment.
c) I assume that the results of the intial query have to be written
to
an Excel sheet
d) Can l then use a SQL statement within VBA to create a sheet with
the results of the crosstab query?
e) If b) can be done does anybody have any example code please? or can
anybody tell me how to amend my existing code?
f) Will 2) be quicker / more efficient than 1)
I have been told by a database expert that because of the layout of
the tables within the financial database a single query cannot give
the desired result. I am not an expert on SQL.
I hope l have explained myself clearly.
All advice gratefully received.
Regards
Michael Beckinsale
CODE:
Option Explicit
Private Const glob_DBPath = "SageLine50v11"
Private Const glob_sConnect = "Provider=MSDASQL.1;Persist Security
Info=False;User ID=manager;Data Source=" & glob_DBPath & ";" '<-----
Note ID & Pasword may need changing
Private Sub RetrieveRecordset(strSQL As String, clTrgt As Range)
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: To retrieve a recordset from a database (via an SQL
query) and place
' it in the supplied worksheet range
'NOTE : Requires a reference to "Microsoft ActiveX Data
Objects 2.x Library"
' (Developed with reference to version 2.0 of the above)
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim rcArray As Variant
Dim lFields As Long
Dim lRecrds As Long
Dim lCol As Long
Dim lRow As Long
'Open connection to the database
cnt.Open glob_sConnect
'Open recordset based on Orders table????????????????
rst.Open strSQL, cnt
'Count the number of fields to place in the worksheet
lFields = rst.Fields.Count
'Check version of Excel
If Val(Mid(Application.Version, 1, InStr(1, Application.Version,
".") - 1)) > 8 Then
'EXCEL 2000 or 2002: Use CopyFromRecordset
'Copy the recordset from the database
On Error Resume Next
clTrgt.CopyFromRecordset rst
'CopyFromRecordset will fail if the recordset contains an OLE
'object field or array data such as hierarchical recordsets
If Err.Number <> 0 Then GoTo EarlyExit
Else
'EXCEL 97 or earlier: Use GetRows then copy array to Excel
'Copy recordset to an array
rcArray = rst.GetRows
'Determine number of records (adds 1 since 0 based array)
lRecrds = UBound(rcArray, 2) + 1
'Check the array for contents that are not valid when
'copying the array to an Excel worksheet
For lCol = 0 To lFields - 1
For lRow = 0 To lRecrds - 1
'Take care of Date fields
If IsDate(rcArray(lCol, lRow)) Then
rcArray(lCol, lRow) = Format(rcArray(lCol, lRow))
'Take care of OLE object fields or array fields
ElseIf IsArray(rcArray(lCol, lRow)) Then
rcArray(lCol, lRow) = "Array Field"
End If
Next lRow
Next lCol
'Transpose and place the array in the worksheet
clTrgt.Resize(lRecrds, lFields).Value = TransposeDim(rcArray)
End If
EarlyExit:
'Close and release the ADO objects
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
On Error GoTo 0
End Sub
Private Function TransposeDim(v As Variant) As Variant
'Function Purpose: Transpose a 0-based array (v)
Dim x As Long, Y As Long, Xupper As Long, Yupper As Long
Dim tempArray As Variant
Xupper = UBound(v, 2)
Yupper = UBound(v, 1)
ReDim tempArray(Xupper, Yupper)
For x = 0 To Xupper
For Y = 0 To Yupper
tempArray(x, Y) = v(Y, x)
Next Y
Next x
TransposeDim = tempArray
End Function
'The routine is called by code such as the following:
Sub GetRecords()
'Macro Purpose: To retrieve a recordset to an Excel worksheet
Dim sSQLQry As String
Dim rngTarget As Range
'WRITE THE SQL QUERY and assign to the variable
'....this example applies specifically to the named database
'....this example query works when connected to PaintballDB.mdb or
Sage Line 50
' sSQLQry = "SELECT NOMINAL_LEDGER.ACCOUNT_REF,
NOMINAL_LEDGER.NAME, " & _
' "NOMINAL_LEDGER.BALANCE FROM NOMINAL_LEDGER;"
'....end of example
'....this code wont work - why?
sSQLQry = "SELECT NOMINAL_LEDGER.NAME,
NOMINAL_LEDGER.ACCOUNT_REF" & _ "WHERE (NOMINAL_LEDGER.ACCOUNT_REF >
4000) FROM NOMINAL_LEDGER;"
'....end of code not working
'Set the Excel target range
'....................................................................................................
ActiveSheet.Cells.ClearContents 'may want to
change as it deletes header information
Set rngTarget = ActiveSheet.Range("A2")
'Retrieve the records
Call RetrieveRecordset(sSQLQry, rngTarget)
End Sub