Odessa
01-05-2007, 03:51 AM
Hi gents,
As you can understand i'm trying to get some data from our Access DB in company and to automate our reporting. i've done digging through the internet and this forum. I found the article from excelguru with the above subject but i still have some problems with it.
I've exactly copied the below code:
Option Explicit
'Constant for Database connection string
Private Const glob_DBPath = "C:\Temp\Examples.mdb"
Private Const glob_sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & glob_DBPath & ";"
Private Sub RetrieveRecordset(strSQL As String, clTrgt As Range)
'Author : Ken Puls
'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-----
to the Class 1
and then
----Sub GetRecords()
'Macro Purpose: To retrieve a recordset to an Excel worksheet
Dim sSQLQry As String
Dim rngTarget As Range
'Generate the SQL query and set the range to place the data in
sSQLQry = "SELECT tblMoorages.CustID, tblMoorages.Type, " & _
"tblMoorages.DatePaid, tblMoorages.Amount FROM tblMoorages;"
ActiveSheet.Cells.ClearContents
Set rngTarget = ActiveSheet.Range("A2")
'Retrieve the records
Call RetrieveRecordset(sSQLQry, rngTarget)
End Subto the Module 1.
After all of these i made couple of changes according to my needs like the path of Access DB and tables and stuff.
Now when i try to run the macro it says
"sub or function not defined" and highlights the Getrecord text. (Probably the problem is with Retrieverecordset thing)
SO then i made some more digging and learned to add reference to ADO. i've added
MS Active X Data objects record Set 2.8 Library and
MS Active X Data objects 2.8 Library
but still getting the same error.
Sorry the question may sound stupid but i've never written a VBA script before so i am pretty novice in this area.
Anyway. Thanks for your help in advance.
PS> Sorry i couldn't be able to put CODE tags because my post count is 0 :whistle:
As you can understand i'm trying to get some data from our Access DB in company and to automate our reporting. i've done digging through the internet and this forum. I found the article from excelguru with the above subject but i still have some problems with it.
I've exactly copied the below code:
Option Explicit
'Constant for Database connection string
Private Const glob_DBPath = "C:\Temp\Examples.mdb"
Private Const glob_sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & glob_DBPath & ";"
Private Sub RetrieveRecordset(strSQL As String, clTrgt As Range)
'Author : Ken Puls
'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-----
to the Class 1
and then
----Sub GetRecords()
'Macro Purpose: To retrieve a recordset to an Excel worksheet
Dim sSQLQry As String
Dim rngTarget As Range
'Generate the SQL query and set the range to place the data in
sSQLQry = "SELECT tblMoorages.CustID, tblMoorages.Type, " & _
"tblMoorages.DatePaid, tblMoorages.Amount FROM tblMoorages;"
ActiveSheet.Cells.ClearContents
Set rngTarget = ActiveSheet.Range("A2")
'Retrieve the records
Call RetrieveRecordset(sSQLQry, rngTarget)
End Subto the Module 1.
After all of these i made couple of changes according to my needs like the path of Access DB and tables and stuff.
Now when i try to run the macro it says
"sub or function not defined" and highlights the Getrecord text. (Probably the problem is with Retrieverecordset thing)
SO then i made some more digging and learned to add reference to ADO. i've added
MS Active X Data objects record Set 2.8 Library and
MS Active X Data objects 2.8 Library
but still getting the same error.
Sorry the question may sound stupid but i've never written a VBA script before so i am pretty novice in this area.
Anyway. Thanks for your help in advance.
PS> Sorry i couldn't be able to put CODE tags because my post count is 0 :whistle: