[2 days left] What’s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now

x
?
Solved

Excel Query Function

Posted on 2011-09-20
10
Medium Priority
?
301 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

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 2000 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

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

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

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
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…

656 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