PDA

View Full Version : Solved: Retrieve Data From A Database To Excel Using SQL



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:

Bob Phillips
01-05-2007, 04:00 AM
We'll soon get the post count up :)

I jsut tried it and it seemd okay, although I failed through lack of THE database.

What exactly did you do? The code mentions Class 1, but there is no class code there that I can see. Where did you put all the code? And what exacty was the error and in which line of code?

Here it is with VBA tags


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

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 Sub

Odessa
01-05-2007, 05:14 AM
Thanks mate.

Forget about the first problem. I think I've sorted that one out. (the code is working unless you are unimaginabley ignorant like me :rotlaugh:)

I've a new problem (pretty cool huh?)

if you have a look at to the attachment you will see a run-time error.
this is probably related with DB table that i am trying to get data from.

i am either entering the wrong name for the table or doing something stupid again.
By the way it says in our Access reports part for the table name dbo_tblRepTeams but i was only using tblRepTeams!!

What do you suggest.

Thanks for your patience.

Cheers.

Odessa
01-05-2007, 05:37 AM
Ok Ok Ok...

Forget about this one as well.


I managed to get the data from the table.

Now i am wondering if i can get data from a query?

Do you think it is possible?

Edit: Spelling mistake.

XLGibbs
01-05-2007, 08:00 AM
You can point to a query the same as you can a table, but you would use

DoCmd.OpenQuery "QueryName"

the only issue would be if the query were linked to an external data source like a SQL server...then it may not work and you would have to go right to the SQL Server.

You can also use MS Query to do this...

Odessa
01-05-2007, 11:31 AM
Thanks mate.
I'll try that tomorrow.

By the way i had a look at to the link in your signature and found a more usefull VBA (for me) as follows.

-----
Option Explicit
Sub Access_Data()
'Requires reference to Microsoft ActiveX Data Objects xx Library

Dim Cn As ADODB.Connection, Rs As ADODB.Recordset
Dim MyConn, sSQL As String

Dim Rw As Long, Col As Long, c As Long
Dim MyField, Location As Range

'Set destination
Set Location = [B2]
'Set source
MyConn = "C:\AAA\db1.mdb"
'Create query
sSQL = "SELECT Table1.Data, Table1.Count FROM Table1;"

'Create RecordSet
Set Cn = New ADODB.Connection
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
Set Rs = .Execute(sSQL)
End With

'Write RecordSet to results area
Rw = Location.Row
Col = Location.Column
c = Col
Do Until Rs.EOF
For Each MyField In Rs.Fields
Cells(Rw, c) = MyField
c = c + 1
Next MyField
Rs.MoveNext
Rw = Rw + 1
c = Col
Loop
Set Location = Nothing
Set Cn = Nothing
End Sub
-----

It gave me the same result (even better cause the first one i tried did not let me to put any fixed data like header in the sheet)

Now i am going to next step.
I want to take out the data from two seperate tables but could't manage to do it.

Do i need to create two seperate macros or can i do it in one go?

Cheers,

XLGibbs
01-05-2007, 11:55 AM
From two separate tables? Can the tables be linked somehow ? if so then you can do it all at once.

strSQL = "Select Table1.Column1, Table2.Column1 " & _
"FROM Table1 inner join Table2 on Table1.[Field] = Table2.[Field]"


For example.

And yes, the KB is full of wonderful things. :)

Odessa
01-06-2007, 04:54 AM
Hi again.

It did not work for some reason. maybe those two tables are not linked to each other or something.

But i have take SS anyway. this may help a little bit.
I am not really sure what FIELD means but i put the cell reference to there as a2 and b2?!?! This may be the problem as well.

Now i will try to put the query into the Excel and will ask about it too.

Thanks for your help which is really appreciated.

Cheers,

XLGibbs
01-06-2007, 07:16 AM
My code was just a syntax example of a typical query.

TableName-dot-ColumnName.

Field would be the column name in the data. In a join you would connect based on identical fields appearing in both tables (like a primary key or something)

The example out of the KB was basic code that would need to be modified appropriately... I am not sure what [A2] and [b2] would be..but they sound like cells in excel, not colum names in tables.

Odessa
01-07-2007, 04:35 AM
Thanks for your help.

i found an easier way for me to do this.

I will explain for those who are novice like me.
when you open access you will see couple of things on the left hand side. As you already have tables in your DB you can create queries can't you?
When you run design view on query tab you can easliy design your query by simply drag and drop kind of way. When you finish your query and get the result as you want you can simply say "sql view" with the same place that you say design view. Than it gives you the sql query code.
Since i am not familiar with sql it made me a great help to just copy it into VBA code in Excel like
sSQLQry = "SELECT dbo_tblAfterSales.PurchaseID..............

So it gave me the result i am looking for.

Now i solved my problem by retrieving data from access to excel.

i'll have more questions later but probably in a new thread.

Thanks again.

Cheers,