Solved

Excel Query Function

Posted on 2011-09-20
10
293 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
 

Author Comment

by:ThomasFoege
Comment Utility
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
Comment Utility
Where are you getting the error?
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 

Author Comment

by:ThomasFoege
Comment Utility
   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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Woks perfectly as always, what would I do without EE/rorya
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

763 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now