Quick question on setting a parameter in a query

[ronaldchua]

Hi there,

Does anyone know how to set a parameter to be "Like 1*" returning 1000, 1100, 1200, 1210 and so on starting with a "1"? Cant seem to get the syntex

Currently my code is:

Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef

Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("ReportGeneration")

qdf.Parameters(0) = Like 1* <------- this is the line I need help in
qdf.Execute


Set qdf = Nothing
Set dbs = Nothing

Any and all help appreciated.

Thanks
Ronald

[ADezii]

Hi there,

Does anyone know how to set a parameter to be "Like 1*" returning 1000, 1100, 1200, 1210 and so on starting with a "1"? Cant seem to get the syntex

Currently my code is:

Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef

Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("ReportGeneration")

qdf.Parameters(0) = Like 1* <------- this is the line I need help in
qdf.Execute


Set qdf = Nothing
Set dbs = Nothing

Any and all help appreciated.

Thanks
Ronald

1. In the ReportGeneration Query, specify the Criteria as follows:
   

   Like [Enter Number:] & "*"

2. Change
   

   qdf.Parameters(0) = Like 1*  TO qdf.Parameters(0) = "1"

3. It seems that you are attempting to Run a SELECT Query. If this is the case, you cannot do this via the Execute Method of a QueryDef Object.

[ronaldchua]

1. In the ReportGeneration Query, specify the Criteria as follows:
   

   Like [Enter Number:] & "*"

2. Change
   

   qdf.Parameters(0) = Like 1*  TO qdf.Parameters(0) = "1"

3. It seems that you are attempting to Run a SELECT Query. If this is the case, you cannot do this via the Execute Method of a QueryDef Object.

Hi ADezil,

Thanks for your reply. I tried what you recommended. An input box pops up when i run the code and it says "Enter number: ". subsequently when i enter '1' everythign from that point on works fine.

But still it seems we're having trouble with the qdf.Parameters(0) = "1" line. Any suggestions? You are right, it's a select query that I'm trying to export to Excel. If the code will make it more clear:

Thanks,
Ronald




Option Compare Database
Option Explicit

Sub ReportSFBayArea()

Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Dim objXLApp As Object

Dim folderpath As String
Dim TemplateName As String
Dim Timecode As Integer
Dim Yr As Integer
Dim Qtr As Integer
Dim x As Integer
Dim y As Integer
Dim Area As Integer

Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("ReportGeneration")
Set objXLApp = CreateObject("Excel.Application")


MsgBox ("This command will export the data to an Excel File for report generation. Afterwards, proceed to run the Macro 'GenerateReport' in Excel")

qdf.Parameters(0) = "1"

folderpath = "C:\HousingMarketReport\Reports\"
TemplateName = "Charting source codes.xls"

objXLApp.Workbooks.Open (folderpath & TemplateName)
objXLApp.Application.Visible = True
On Error Resume Next
Kill (folderpath & "Temp.xls")

objXLApp.ActiveWorkbook.SaveAs folderpath & "Temp.xls"
objXLApp.ActiveWorkbook.Close savechanges:=False

objXLApp.Application.Quit

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ReportGeneration", "c:\HousingMarketReport\Reports\Temp.xls"

objXLApp.Application.DisplayAlerts = False

objXLApp.Application.Visible = True
objXLApp.Workbooks.Open (folderpath & "Temp.xls")
objXLApp.Worksheets("sheet1").cells.Delete
objXLApp.Worksheets("sheet1").Delete

x = 1
y = 1

Do While objXLApp.cells(x, y) <> "TimeCode" And IsEmpty(objXLApp.cells(x, y)) = False
y = y + 1
Loop

Do
x = x + 1
Loop While CInt(objXLApp.cells(x + 1, y)) > CInt(objXLApp.cells(x, y)) And IsEmpty(objXLApp.cells(x + 1, y)) = False

Timecode = CInt(objXLApp.cells(x, y))
Qtr = Timecode Mod 4
If Qtr = 0 Then Qtr = 4
Yr = (Timecode - Qtr) / 4

On Error Resume Next
Kill (folderpath & Yr & "Q" & Qtr & "Report.xls")
objXLApp.ActiveWorkbook.SaveAs folderpath & Yr & "Q" & Qtr & "Report.xls"
Kill (folderpath & "Temp.xls")

Set objXLApp = Nothing
Set qdf = Nothing
Set dbs = Nothing

DoCmd.Quit


End Sub

[ADezii]

Hi ADezil,

Thanks for your reply. I tried what you recommended. An input box pops up when i run the code and it says "Enter number: ". subsequently when i enter '1' everythign from that point on works fine.

But still it seems we're having trouble with the qdf.Parameters(0) = "1" line. Any suggestions? You are right, it's a select query that I'm trying to export to Excel. If the code will make it more clear:

Thanks,
Ronald

Option Compare Database
Option Explicit

Sub ReportSFBayArea()

Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Dim objXLApp As Object

Dim folderpath As String
Dim TemplateName As String
Dim Timecode As Integer
Dim Yr As Integer
Dim Qtr As Integer
Dim x As Integer
Dim y As Integer
Dim Area As Integer

Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("ReportGeneration")
Set objXLApp = CreateObject("Excel.Application")


MsgBox ("This command will export the data to an Excel File for report generation. Afterwards, proceed to run the Macro 'GenerateReport' in Excel")

qdf.Parameters(0) = "1"

folderpath = "C:\HousingMarketReport\Reports\"
TemplateName = "Charting source codes.xls"

objXLApp.Workbooks.Open (folderpath & TemplateName)
objXLApp.Application.Visible = True
On Error Resume Next
Kill (folderpath & "Temp.xls")

objXLApp.ActiveWorkbook.SaveAs folderpath & "Temp.xls"
objXLApp.ActiveWorkbook.Close savechanges:=False

objXLApp.Application.Quit

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ReportGeneration", "c:\HousingMarketReport\Reports\Temp.xls"

objXLApp.Application.DisplayAlerts = False

objXLApp.Application.Visible = True
objXLApp.Workbooks.Open (folderpath & "Temp.xls")
objXLApp.Worksheets("sheet1").cells.Delete
objXLApp.Worksheets("sheet1").Delete

x = 1
y = 1

Do While objXLApp.cells(x, y) <> "TimeCode" And IsEmpty(objXLApp.cells(x, y)) = False
y = y + 1
Loop

Do
x = x + 1
Loop While CInt(objXLApp.cells(x + 1, y)) > CInt(objXLApp.cells(x, y)) And IsEmpty(objXLApp.cells(x + 1, y)) = False

Timecode = CInt(objXLApp.cells(x, y))
Qtr = Timecode Mod 4
If Qtr = 0 Then Qtr = 4
Yr = (Timecode - Qtr) / 4

On Error Resume Next
Kill (folderpath & Yr & "Q" & Qtr & "Report.xls")
objXLApp.ActiveWorkbook.SaveAs folderpath & Yr & "Q" & Qtr & "Report.xls"
Kill (folderpath & "Temp.xls")

Set objXLApp = Nothing
Set qdf = Nothing
Set dbs = Nothing

DoCmd.Quit


End Sub

I have a quick, down-and-dirty solution that is not very elegant, but it should definately work. Just 2 simple steps:

1. Delete the line qdf.Parameters(0) = "1". The fact that this is a SELECT and not an ACTION Query changes everything. Now, you cannot resolve the single Parameter in this manner and use the Execute Method of the QueryDef Object, so just remove the line.
2. Insert this line prior to the TransferSpreadsheet line of code as indicated below. We'll let SendKeys insert the 1 and ENTER Key into the Parameter Dialog Box. For a different Parameter, us a different number, but the syntax must remain the same:
   

   SendKeys "1{ENTER}"
   DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ReportGeneration", "c:\HousingMarketReport\Reports\Temp.xls"

3. Let me know how you make out.

[ronaldchua]

I have a quick, down-and-dirty solution that is not very elegant, but it should definately work. Just 2 simple steps:

1. Delete the line qdf.Parameters(0) = "1". The fact that this is a SELECT and not an ACTION Query changes everything. Now, you cannot resolve the single Parameter in this manner and use the Execute Method of the QueryDef Object, so just remove the line.
2. Insert this line prior to the TransferSpreadsheet line of code as indicated below. We'll let SendKeys insert the 1 and ENTER Key into the Parameter Dialog Box. For a different Parameter, us a different number, but the syntax must remain the same:
   

   SendKeys "1{ENTER}"
   DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ReportGeneration", "c:\HousingMarketReport\Reports\Temp.xls"

3. Let me know how you make out.

Hey ADezii,

Yep it works great! Thanks for your help and I learnt a new function today!

Ronald

[ADezii]

Hey ADezii,

Yep it works great! Thanks for your help and I learnt a new function today!

Ronald

You're quite welcome.