Running An Access Query Using Excel VBA

[RunTime91]

Hello...

I have the following code in my Excel VBE attached to a button that when clicked runs a query in Access then places the results into an Excel sheet

It works perfectly, but only so far as I hard code the date of the data I want returned in the Access query.

Naturally, I need the query to return data based upon a date entered into a cell in my Excel sheet.

I've tried several solutions (using parameters and other types of variables) which have resulted in several types of errors.

The Sheet.Range where the date will be entered is: Sheets("DataEntry").Range("D5") - Which you will see referenced (commented out) in the code as a TargetRange Variable.

Thank you so much for any help - Also, I have cross posted this in the Access forum as I'm not sure which one this question belongs to.

Sub RunRepository()Dim Con As Object
Dim Rs As Object
Dim AccessFile As String
Dim TargetRange As Range
Dim i As Integer
Dim Cmd As ADODB.Command
Dim StrQuery As String

Application.ScreenUpdating = False

AccessFile = ("N:\Referral Management (RAOC)\Internal\@DeptCommon\MorningRpt\MorningRpt.accdb")
StrQuery = "QryTest"

On Error Resume Next

Set Con = CreateObject("ADODB.Connection")
If Err.Number <> 0 Then
  MsgBox ("Connection was not created")
  Exit Sub
End If
On Error GoTo 0
With Con
  .Open "Provider = Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
End With

'''''Set TargetRange = Sheets("DataEntry").Range("D5")
'''''With Cmd
'''''  .Parameters = ("Prm")
'''''End With

Set Rs = CreateObject("ADODB.Recordset")
If Err.Number <> 0 Then
  Set Rs = Nothing
  Set Con = Nothing
  
  MsgBox ("Recordset was not created")
  Exit Sub
End If
On Error GoTo 0
Rs.Open StrQuery, Con
 'Check if the recordet is empty.
    If Rs.EOF And Rs.BOF Then
        'Close the recordet and the connection.
        Rs.Close
        Con.Close
        'Release the objects.
        Set Rs = Nothing
        Set Con = Nothing
        'Enable the screen.
        Application.ScreenUpdating = True
        'In case of an empty recordset display an error.
        MsgBox "There are no records in the recordset!", vbCritical, "No Records"
        Exit Sub
    End If
Sheets("Repository").Range("A2").CopyFromRecordset Rs

Rs.Close
Con.Close 

End Sub

 

[VBA Geek]

You can create a parameter within your query:

and then when you run the query with Excel you can pass the date value to the query using the parameter:

Function getData(ByVal DateInput As Date) As ADODB.Recordset


Dim dbCommand As ADODB.Command


Set dbCommand = CreateObject("adodb.command")


With dbCommand
    .ActiveConnection = yourConnectionObject '(adodb.connection)
    .CommandType = adCmdStoredProc
    .CommandText = YourAccessQueryName
    .Parameters.Append .CreateParameter("paramDateInput", adDate, adParamInput, , DateInput) ' paramDateInput is the same as in the access query
    
    Set getData = .Execute()
End With


Set dbCommand = Nothing
End Function

 

[RunTime91]

Geek -

Thank You so much for responding...

I'm trying to get your code to work (I'm not entirely familiar with Functions) and while I get no error I also do not get the desired result

I have backfilled your code with what I think should go in the places you outlined (as below), but when I hit F5 it seems to ignore the function and just asks what macro I want to run
Again, I'm not very familiar with how to use functions...Can you get me to the next step... Thanks Geek..

Function getData(ByVal DateInput As Date) As ADODB.Recordset
Dim DbCommand As ADODB.Command
Dim Con As Object
Set DbCommand = CreateObject("ADODB.Command")
Set Con = CreateObject("ADODB.Connection")

With DbCommand
    .ActiveConnection = "Provider = Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile '(adodb.connection)
    .CommandType = "RunRepository"
    .CommandText = "QryTest"
    .Parameters.Append .CreateParameter(Sheets("DataEntry").Range("D5"), adDate, adParamInput, , DateInput) ' paramDateInput is the same as in the access query
    Set getData = .Execute()
End With

Set DbCommand = Nothing
End Function

I get a Syntax error on the .ActiveConnection when I try to plug in my Con string from my code

 

[RunTime91]

Is there anyone else available to take a crack at this?

I've been at this for hours and both YouTube and Google have issues a cease & desist orders...

This just can't be that difficult (for those who know how - which I do not)

I'm sure Geek's code is good, but I simply cannot get it to work

Thanks very much

 

[RunTime91]

I believe I have set the variables in Geeks Function correctly - and now I believe I have to figure out a way to call the function within my original script - I think

Can someone please let me know if I am going down the right path and if so can someone please help me get to the finish line with this

Thanks...

 

[VBA Geek]

I have merged the function within your initial routine so you can understand it better:

Sub ttt()


Dim Con       As ADODB.Connection
Dim RS        As ADODB.Recordset
Dim myCommand As ADODB.Command


Dim AccessFile As String


Set Con = CreateObject("ADODB.Connection")


AccessFile = ("N:\Referral Management (RAOC)\Internal\@DeptCommon\MorningRpt\MorningRpt.accdb")


With Con
  .Open "Provider = Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
End With


Set myCommand = CreateObject("adodb.command")


With myCommand
    .ActiveConnection = Con
    .CommandType = adCmdStoredProc
    .CommandText = "QryTest"
    .Parameters.Append .CreateParameter("paramDateInput", adDate, adParamInput, , Sheets("DataEntry").Range("D5").Value)
    
    Set RS = .Execute()
End With




' continue with your checks if rs is empty etc.




End Sub

 

[xenou]

@RunTime, this looks wrong:

    .CommandType = "RunRepository"
    .CommandText = "QryTest"

cmd type should probably be adCmdStoredProc as in VBA Geek's post (i.e., a saved query in Access), while cmd Text should probably be RunRepository (i.e., the name of the saved query in Access).

 

[RunTime91]

Geek & Xenou ~

Thank you both so very much for sticking with me on this

I ventured a little beyond my reach with this one, and without your help - I would still be working on it.

Again, I can't thank both of you enough!

RT91

 

[RunTime91]

Ugh!!!

So I adopted the code to another query and now I'm getting an "Invalid SQL statement error (Expected Select, Delete, Insert blah, blah, blah)

Below is the code in Excel

Sub RunRepository()
Dim Con As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim AccessFile As String
Dim TargetRange As Range
Dim Cmd As ADODB.Command
Dim StrQuery As String

Application.ScreenUpdating = False
AccessFile = ("N:\Referral Management (RAOC)\Internal\@DeptCommon\MorningRpt\MorningRpt.accdb")
StrQuery = "QryFx3"
On Error Resume Next

Set Con = New ADODB.Connection
If Err.Number <> 0 Then
  MsgBox ("Connection was not created")
  Exit Sub
End If
On Error GoTo 0

With Con
  .Open "Provider = Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
End With

Set Cmd = CreateObject("ADODB.Command")
With Cmd
  .ActiveConnection = Con
    .CommandType = adCmdStoredProc
      .CommandText = "QryFx3"
    .Parameters.Append .CreateParameter("DateInput", adDate, adParamInput, , Sheets("DataEntry").Range("D5").Value)
  Set Rs = .Execute()
End With

Set Rs = New ADODB.Recordset

If Err.Number <> 0 Then
  Set Rs = Nothing
  Set Con = Nothing
  MsgBox ("Recordset was not created")
  Exit Sub
End If

On Error GoTo 0

Rs.Open StrQuery, Con [COLOR=#ff0000]<-------- THIS IS WHERE THE ERROR IS OCCURING[/COLOR]

 'Check if the recordet is empty.
    If Rs.EOF And Rs.BOF Then
        'Close the recordet and the connection if empty.
        Rs.Close
        Con.Close
        'Release the objects.
        Set Rs = Nothing
        Set Con = Nothing
        'Enable screen.
        Application.ScreenUpdating = True
        'In case of an empty recordset display an error.
        MsgBox "There are no records in the recordset!", vbCritical, "No Records"
    End If

Sheets("Repository").Range("A2").CopyFromRecordset Rs

Rs.Close
Con.Close

End Sub

Below is the SQL Statement

PARAMETERS DateInput DateTime;
SELECT TblInvCOB.COBDate AS COBDate, Round(([104_FxdUrg]+[105_FxdRout])*0.6) AS 23_RefFaxBacks,
([tblInvCOB].[103_FxdEDI]+[tblInvCOB].[104_FxdUrg]+[105_FxdRout])-[23_RefFaxBacks] AS 24_AuthFaxBacks,
TblInvCOB.[102_ReturnedMail] AS 25_ReturnedMail
FROM TblInvCOB
WHERE (((TblInvCOB.COBDate)=[DateInput]));

I tried moving the PARAMETERS script to not be the first line and then removed it altogether (which removes it from the Parameters window)

And nothing - the error persists

Fwiw, the SQL statement runs perfectly in the Access VBE it only errors when trying to run it from Excel

Thank you again for any help

 

[RunTime91]

I have now replace the StrQry variable with the entire SQL Statement and while I seem to have gotten passed the Invalid SQL Statement error I'm now getting a

The SELECT statement includes a reserved word or an argument name that is misspelled or missing, blah blah blah

Below is the SQL statement as it appears in the Excel VBE

Rs.Open "SELECT TblInvCOB.COBDate AS COBDate, Round(([104_FxdUrg]+[105_FxdRout])*0.6) AS 23_RefFaxBacks, " & _
          "([tblInvCOB].[103_FxdEDI]+[tblInvCOB].[104_FxdUrg]+[105_FxdRout])-[23_RefFaxBacks] AS 24_AuthFaxBacks, " & _
          "TblInvCOB.[102_ReturnedMail] AS 25_ReturnedMail," & _
          "FROM TblInvCOB " & _
          "WHERE(((TblInvCOB.COBDate) = [DateInput]));", Con

Help? Thanks as always...