Parameter Query VB

[Kathleen0422]

Good Morning and Happy Monday,

I have an access database with a parameter based query, following is the SQL


PARAMETERS [Date Worked] DateTime;
SELECT tbl_Hours.TMID, tbl_Hours.CostCenter, tbl_Hours.TRC_Code, tbl_Hours.Name, Sum(tbl_Hours.Hours) AS SumOfHours
FROM tbl_Hours

WHERE Date_Worked <= [Date Worked]
GROUP BY tbl_Hours.TMID, tbl_Hours.CostCenter, tbl_Hours.TRC_Code, tbl_Hours.Name
HAVING (((tbl_Hours.TRC_Code)="COMPE" Or (tbl_Hours.TRC_Code)="COMPT" Or (tbl_Hours.TRC_Code)="COMPU" Or (tbl_Hours.TRC_Code)="COMPM"));


Through a macro in Excel I would like to execute this query, but can't seem to do so. I am using the Macro Recorder and it fails stating that I have to few parameters.

Any help would be greatly appreciated.

Thanks,

 

[Kenneth Hobson]

You might try a QueryTable. e.g.

Sub Test()
  Dim mdbPath As String, dbName As String, cmdText As String
  Dim rngDestination As String
  mdbPath = "//matpc10/ExcelVBAExamples/ado/NWind2003.mdb"
  dbName = "NWind2003_1"              'change the name here to suit
  cmdText = "Aug94"                   'change the stored SQL here to suit your needs
  rngDestination = "A1"               'change the destination range here to suit your needs
  
  'Clear previous data
  Cells.Delete

  InsertTableWithStoredSQL mdbPath, dbName, cmdText, rngDestination
  
  'Insert other data to the right of A1 with a blank column separating the two
  rngDestination = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 2).Address
  cmdText = "Sales by Category"
  InsertTableWithStoredSQL mdbPath, dbName, cmdText, rngDestination
End Sub

Sub InsertTableWithStoredSQL(mdbPath As String, dbName As String, _
  cmdText As String, rngDestination As String, _
  Optional bFieldNames = True)

    With ActiveSheet.QueryTables.Add(Connection:=Array( _
                                                 "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & mdbPath & ";Mode=ReadWrite;Extended Properties=""" _
       , """;Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Datab" _
       , "ase Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";J" _
       , "et OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Co" _
       , "mpact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination:=Range("" & rngDestination & ""))
        .CommandType = xlCmdTable
        .CommandText = Array(cmdText)
        .Name = dbName
        .FieldNames = bFieldNames
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = mdbPath
        .Refresh BackgroundQuery:=False
    End With
End Sub

 

[Kathleen0422]

Thank You, am in a meeting right now but will try shortly and advise

 

[Kathleen0422]

Kenneth Thanks for your speedy response. It's been a heck of a week here and I just tried to get this to work again unsucessfully,

I opened a blank Excel Spreadsheet and inserted a module, I copied an pasted your code into that module and I am receiving a Runtime Error 13, on the .CommandText = Array(cmdText)

Following is the Code I have

Sub Test()
Dim mdbPath As String, dbName As String, cmdText As String
Dim rngDestination As String
Dim CompTimeBegin As Date
 
mdbPath = "C:\Overtime Reporting\Overtime.mdb"
dbName = "Overtime" 'change the name here to suit
 
 
CompTimeBegin = 2 / 28 / 2009
Start_Work = CompTimeBegin
 
cmdText = "PARAMETERS [Start_Work] DateTime; "
cmdText = cmdText & "SELECT tbl_Hours.TMID, tbl_Hours.CostCenter, tbl_Hours.TRC_Code, tbl_Hours.Name, Sum(tbl_Hours.Hours) AS SumOfHours "
cmdText = cmdText & " FROM tbl_Hours WHERE (((tbl_Hours.Date_Worked) <= [Start_Work]))"
cmdText = cmdText & " GROUP BY tbl_Hours.TMID, tbl_Hours.CostCenter, tbl_Hours.TRC_Code, tbl_Hours.Name"
cmdText = cmdText & " HAVING (((tbl_Hours.TRC_Code)=""COMPE"" Or (tbl_Hours.TRC_Code)=""COMPT"" Or (tbl_Hours.TRC_Code)=""COMPU"" Or (tbl_Hours.TRC_Code)=""COMPM""));" 'change the stored SQL here to suit your needs
rngDestination = "A1" 'change the destination range here to suit your needs
 
'Clear previous data
Cells.Delete
InsertTableWithStoredSQL mdbPath, dbName, cmdText, rngDestination
 
'Insert other data to the right of A1 with a blank column separating the two
rngDestination = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 2).Address
cmdText = "Sales by Category"
InsertTableWithStoredSQL mdbPath, dbName, cmdText, rngDestination
End Sub
 
Sub InsertTableWithStoredSQL(mdbPath As String, dbName As String, _
cmdText As String, rngDestination As String, _
Optional bFieldNames = True)
 
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & mdbPath & ";Mode=ReadWrite;Extended Properties=""" _
, """;Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Datab" _
, "ase Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";J" _
, "et OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Co" _
, "mpact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination:=Range("" & rngDestination & ""))
.CommandType = xlCmdTable
.CommandText = Array(cmdText)
.Name = dbName
.FieldNames = bFieldNames
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = mdbPath
.Refresh BackgroundQuery:=False
End With
 
End Sub

I sure would appreciate your help.

 

[Kenneth Hobson]

Your date variable is not set as you expect, I suspect. Here are two ways to set a date variable. If it works correctly and it does, my +1 adds one day to the date.

Sub SubDate()
  MsgBox DateSerial(2004, 1, 15) + 1
  MsgBox #1/15/2005# + 1
End Sub

 

[Kathleen0422]

Good Morning Kenneth and thanks for your help.

I am still receiving an error 13 Type Mismatch on the line

.CommandText = Array(cmdText)

Sub Test()
Dim mdbPath As String, dbName As String, cmdText As String
Dim rngDestination As String
Dim CompTimeBegin, Start_Work As Date

mdbPath = "C:\Overtime Reporting\Overtime.mdb"
dbName = "Overtime" 'change the name here to suit

CompTimeBegin = #2/28/2009#
Start_Work = CompTimeBegin

cmdText = "PARAMETERS [Start_Work] DateTime; "
cmdText = cmdText & "SELECT tbl_Hours.TMID, tbl_Hours.CostCenter, tbl_Hours.TRC_Code, tbl_Hours.Name, Sum(tbl_Hours.Hours) AS SumOfHours "
cmdText = cmdText & " FROM tbl_Hours WHERE (((tbl_Hours.Date_Worked) <= [Start_Work]))"
cmdText = cmdText & " GROUP BY tbl_Hours.TMID, tbl_Hours.CostCenter, tbl_Hours.TRC_Code, tbl_Hours.Name"
cmdText = cmdText & " HAVING (((tbl_Hours.TRC_Code)=""COMPE"" Or (tbl_Hours.TRC_Code)=""COMPT"" Or (tbl_Hours.TRC_Code)=""COMPU"" Or (tbl_Hours.TRC_Code)=""COMPM""));" 'change the stored SQL here to suit your needs
rngDestination = "A1" 'change the destination range here to suit your needs

'Clear previous data
Cells.Delete
InsertTableWithStoredSQL mdbPath, dbName, cmdText, rngDestination

'Insert other data to the right of A1 with a blank column separating the two
rngDestination = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 2).Address
cmdText = "Sales by Category"
InsertTableWithStoredSQL mdbPath, dbName, cmdText, rngDestination
End Sub

Sub InsertTableWithStoredSQL(mdbPath As String, dbName As String, _
cmdText As String, rngDestination As String, _
Optional bFieldNames = True)

With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & mdbPath & ";Mode=ReadWrite;Extended Properties=""" _
, """;Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Datab" _
, "ase Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";J" _
, "et OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Co" _
, "mpact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination:=Range("" & rngDestination & ""))
.CommandType = xlCmdTable
.CommandText = Array(cmdText)
.Name = dbName
.FieldNames = bFieldNames
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = mdbPath
.Refresh BackgroundQuery:=False
End With


End Sub

 

[Kenneth Hobson]

After you build the cmdText string, use Debug.Print and view the string in the Immediate window of the VBE. Is it what you expected? This is where you see how you need to tweak your code.

e.g.

cmdText = "PARAMETERS [Start_Work] DateTime; "
cmdText = cmdText & "SELECT tbl_Hours.TMID, " & _
tbl_Hours.CostCenter, tbl_Hours.TRC_Code, " & _
"tbl_Hours.Name, Sum(tbl_Hours.Hours) AS SumOfHours "

Debug.Print cmdText

 

[Kathleen0422]

Hi Kenneth, This is the result.


PARAMETERS [Start_Work] DateTime; SELECT tbl_Hours.TMID, tbl_Hours.CostCenter, tbl_Hours.TRC_Code, tbl_Hours.Name, Sum(tbl_Hours.Hours) AS SumOfHours FROM tbl_Hours WHERE (((tbl_Hours.Date_Worked) <= [Start_Work])) GROUP BY tbl_Hours.TMID, tbl_Hours.CostCenter, tbl_Hours.TRC_Code, tbl_Hours.Name HAVING (((tbl_Hours.TRC_Code)="COMPE" Or (tbl_Hours.TRC_Code)="COMPT" Or (tbl_Hours.TRC_Code)="COMPU" Or (tbl_Hours.TRC_Code)="COMPM"));

I had put it in a msgbox earlier to view, still same problem

 

[Kathleen0422]

I desperately need help. I have been working on this for days now and its Fiscal year end close. I would be eternally indebted for any advice anyone can offer.

I have given up on the previous posts and have attempted to write the SQL in this format, I
am receiving an error 13 when it gets to .CommandText = Array(strSQL)

THis is what I now have

Sub Test()

Dim TheStartDate As Date
Dim strSQL As Variant

Range("A1").Select
TheStartDate = ActiveCell.Value


strSQL = "SELECT tbl_Hours.TMID, tbl_Hours.CostCenter, tbl_Hours.TRC_Code, tbl_Hours.Name, Sum(tbl_Hours.Hours) AS SumOfHours "
strSQL = strSQL & " FROM tbl_Hours "
strSQL = strSQL & " WHERE (((tbl_Hours.Date_Worked) <#" & Format(TheStartDate, "mm/dd/yyyy") & "#"
strSQL = strSQL & " GROUP BY tbl_Hours.TMID, tbl_Hours.CostCenter, tbl_Hours.TRC_Code, tbl_Hours.Name"
strSQL = strSQL & " HAVING (((tbl_Hours.TRC_Code)=""COMPE"" Or (tbl_Hours.TRC_Code)=""COMPT"" Or (tbl_Hours.TRC_Code)=""COMPU"" Or (tbl_Hours.TRC_Code)=""COMPM""));"

Debug.Print strSQL

With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=C:\Overtime Reporting\Overtime.mdb;DefaultDir=C:\Overtime Reporting;DriverId=25;FIL=MS Access;MaxBuf" _
), Array("ferSize=2048;PageTimeout=5;")), Destination:=Range("A1"))
.CommandText = Array(strSQL)
.Name = "Query from MS Access Database"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub



When I look at the debug text, this is what is returned

SELECT tbl_Hours.TMID, tbl_Hours.CostCenter, tbl_Hours.TRC_Code, tbl_Hours.Name, Sum(tbl_Hours.Hours) AS SumOfHours FROM tbl_Hours WHERE (((tbl_Hours.Date_Worked) <#02/28/2009# GROUP BY tbl_Hours.TMID, tbl_Hours.CostCenter, tbl_Hours.TRC_Code, tbl_Hours.Name HAVING (((tbl_Hours.TRC_Code)="COMPE" Or (tbl_Hours.TRC_Code)="COMPT" Or (tbl_Hours.TRC_Code)="COMPU" Or (tbl_Hours.TRC_Code)="COMPM"));