Solved

Excel Query Function

Posted on 2011-09-20
10
295 Views
Last Modified: 2012-06-21
Hello EE!

I'm trying to, with the previous help i got here, to create a function that can do a query to an access database.  However I'm not certain about datatypes and the procedure for using functions, but so far I've come up with this:

The query function:
Private Function DoQuery(strQuery As String) As Range

   ' Connection Details

   Dim cnn As ADODB.Connection, rst As ADODB.Recordset
   Dim strPathToDB As String, strFormula As String, i As Long
   Dim wks As Worksheet
   Dim lngNextNum As Long, lngRow As Long, lngCol As Long
   Dim varData
   Dim strTable As String, strField1 As String, strField2 As String
   
   ' Path to database
   strPathToDB = Worksheets("Menu").Range("D4").Value
   strTable = Worksheets("Menu").Range("D5").Value

   ' Connect
   Set cnn = New ADODB.Connection
   With cnn
      .CursorLocation = adUseServer
      .ConnectionTimeout = 500
      .Provider = "Microsoft.ACE.OLEDB.12.0"
      .ConnectionString = "Data Source=" & strPathToDB & ";"
      .Open
      .CommandTimeout = 500
   End With
   
   ' Do query
   Set rst = New ADODB.Recordset
   
   With rst
      .CursorLocation = adUseClient
      .Open strQuery, cnn, adOpenStatic, adLockPessimistic, adCmdText

      If Not .EOF Then
          DoQuery.CopyFromRecordset rst
      End If
      .Close
   End With
   
   ' Clean up
   Set rst = Nothing
   cnn.Close
   Set cnn = Nothing
   
End Function

Open in new window


And then the code using it:

Public Sub GetValidationData()

   strPathToDB = Worksheets("Menu").Range("D4").Value
   strTable = Worksheets("Menu").Range("D5").Value
   
   q_db_year = Worksheets("Menu_DB_Definition").Range("db_year").Value
   q_db_spend = Worksheets("Menu_DB_Definition").Range("db_spend").Value
   
   Results = DoQuery("SELECT [" & strTable & "].[" & q_db_year & "], Sum([" & strTable & "].[" & q_db_spend & "]) AS SumSpend FROM [" & strTable & "] GROUP BY [" & strTable & "].[" & q_db_year & "];")
   ActiveSheet.Cells(4, "G").CopyFromRecordset Results
      
End Sub

Open in new window


However, i get an error 91, Object variable or with block variable not set on the last line of the code
ActiveSheet.Cells(4, "G").CopyFromRecordset Results

Open in new window


I cannot seem to figure out what I'm doing wrong. I hope one of you out there have an idea to my problem

Thanks in advance!
0
Comment
Question by:ThomasFoege
  • 5
  • 5
10 Comments
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 36565345
Your function needs to return a recordset for you to use it like that. Currently it doesn't actually return anything. Try:
Private Function DoQuery(strQuery As String) As Recordset

   ' Connection Details

   Dim cnn As ADODB.Connection, rst As ADODB.Recordset
   Dim strPathToDB As String, strFormula As String, i As Long
   Dim wks As Worksheet
   Dim lngNextNum As Long, lngRow As Long, lngCol As Long
   Dim varData
   Dim strTable As String, strField1 As String, strField2 As String
   
   ' Path to database
   strPathToDB = Worksheets("Menu").Range("D4").Value
   strTable = Worksheets("Menu").Range("D5").Value

   ' Connect
   Set cnn = New ADODB.Connection
   With cnn
      .CursorLocation = adUseServer
      .ConnectionTimeout = 500
      .Provider = "Microsoft.ACE.OLEDB.12.0"
      .ConnectionString = "Data Source=" & strPathToDB & ";"
      .Open
      .CommandTimeout = 500
   End With
   
   ' Do query
   Set DoQuery = New ADODB.Recordset
   
   With DoQuery
      .CursorLocation = adUseClient
      .Open strQuery, cnn, adOpenStatic, adLockPessimistic, adCmdText
   End With
   
   cnn.Close
   Set cnn = Nothing
   
End Function

Open in new window


then use:
Public Sub GetValidationData()

   strPathToDB = Worksheets("Menu").Range("D4").Value
   strTable = Worksheets("Menu").Range("D5").Value
   
   q_db_year = Worksheets("Menu_DB_Definition").Range("db_year").Value
   q_db_spend = Worksheets("Menu_DB_Definition").Range("db_spend").Value
   
   Set Results = DoQuery("SELECT [" & strTable & "].[" & q_db_year & "], Sum([" & strTable & "].[" & q_db_spend & "]) AS SumSpend FROM [" & strTable & "] GROUP BY [" & strTable & "].[" & q_db_year & "];")
   If Not Results.EOF Then ActiveSheet.Cells(4, "G").CopyFromRecordset Results
      
End Sub

Open in new window

0
 

Author Comment

by:ThomasFoege
ID: 36565377
Ah I see, using you functions i run into a runtime error 3704, application-defined or object defined error? Is that the references again?
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 36565497
Possibly - I should have specified the recordset type for the function:
Private Function DoQuery(strQuery As String) As ADODB.Recordset

   ' Connection Details

   Dim cnn As ADODB.Connection, rst As ADODB.Recordset
   Dim strPathToDB As String, strFormula As String, i As Long
   Dim wks As Worksheet
   Dim lngNextNum As Long, lngRow As Long, lngCol As Long
   Dim varData
   Dim strTable As String, strField1 As String, strField2 As String
   
   ' Path to database
   strPathToDB = Worksheets("Menu").Range("D4").Value
   strTable = Worksheets("Menu").Range("D5").Value

   ' Connect
   Set cnn = New ADODB.Connection
   With cnn
      .CursorLocation = adUseServer
      .ConnectionTimeout = 500
      .Provider = "Microsoft.ACE.OLEDB.12.0"
      .ConnectionString = "Data Source=" & strPathToDB & ";"
      .Open
      .CommandTimeout = 500
   End With
   
   ' Do query
   Set DoQuery = New ADODB.Recordset
   
   With DoQuery
      .CursorLocation = adUseClient
      .Open strQuery, cnn, adOpenStatic, adLockPessimistic, adCmdText
   End With
   
   cnn.Close
   Set cnn = Nothing
   
End Function

Open in new window


as that could cause problems if you have a DAO reference set too.
0
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 

Author Comment

by:ThomasFoege
ID: 36565568
I'm getting same error, i got these references:

VB for applications
Microsoft excel 14
OLE Automation
Microsoft office 14
Microsoft ActiveX Data Objects 6.0
Microsoft Office 14
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 36565630
Where are you getting the error?
0
 

Author Comment

by:ThomasFoege
ID: 36565640
   Set Results = DoQuery("SELECT [" & strTable & "].[" & q_db_year & "], Sum([" & strTable & "].[" & q_db_spend & "]) AS SumSpend FROM [" & strTable & "] GROUP BY [" & strTable & "].[" & q_db_year & "];")
   If Not Results.EOF Then ActiveSheet.Cells(4, "G").CopyFromRecordset Results

Open in new window


I checked with a messagebox that the query is correct. I think the error is in the If Not line?
0
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 500 total points
ID: 36565711
Sorry - forgot the line to terminate the connection. The function code needs to be altered to:
Private Function DoQuery(strQuery As String) As ADODB.Recordset

   ' Connection Details

   Dim cnn As ADODB.Connection, rst As ADODB.Recordset
   Dim strPathToDB As String, strFormula As String, i As Long
   Dim wks As Worksheet
   Dim lngNextNum As Long, lngRow As Long, lngCol As Long
   Dim varData
   Dim strTable As String, strField1 As String, strField2 As String
   
   ' Path to database
   strPathToDB = Worksheets("Menu").Range("D4").Value
   strTable = Worksheets("Menu").Range("D5").Value

   ' Connect
   Set cnn = New ADODB.Connection
   With cnn
      .CursorLocation = adUseClient
      .ConnectionTimeout = 500
      .Provider = "Microsoft.ACE.OLEDB.12.0"
      .ConnectionString = "Data Source=" & strPathToDB & ";"
      .Open
      .CommandTimeout = 500
   End With
   
   ' Do query
   Set DoQuery = New ADODB.Recordset
   
   With DoQuery
      .CursorLocation = adUseClient
      .Open strQuery, cnn, adOpenStatic, adLockPessimistic, adCmdText
      .ActiveConnection = Nothing
   End With
   
   cnn.Close
   Set cnn = Nothing
   
End Function

Open in new window

0
 

Author Comment

by:ThomasFoege
ID: 36565716
That works perfectly!

Is there any way to call this function from another sheet or should i copy it to all sheets i use it in?
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 36565731
You should put the code into a normal module (not a worksheet code module). You can then call it from anywhere in the same project.
0
 

Author Closing Comment

by:ThomasFoege
ID: 36565747
Woks perfectly as always, what would I do without EE/rorya
0

Featured Post

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

808 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question