Search form Code to show Select Items and also Same from Previous YearTable

[Trevor G]

I have been asked to extend a question that has been resolved once.

I now have the code to build a query and also a spreadsheet from selecting items on a search form and check boxes from what I select from the list box and tick which ever check box I select it builds the query and spreadsheet. I have been asked to extend this now to show the previous years values based on the same field names. So I have now a history table, what would I to fetch the fields but from the history table. I am showing the code below the History table is called TempImportOld and all the fields are named the same. I have attached a sample database with the 2 tables and the form.

Private Sub cmdGenerate_Click()
Dim frm As Form, ctl As Control
Dim i As Long
Dim LngCnt As Long
Dim dummy As Variant
Dim strSQL As String
Dim strSQL1 As String
Dim dB As Database
Dim qry As QueryDef
Dim varItm As Variant
Dim strparam As String
Dim strfrom As String

strSQL = "SELECT [tempImported].Product1"
strfrom = " FROM [tempImported]"
strparam = " WHERE "

Set frm = Forms!frmReportCreator
Set ctl = frm!ltsProduct1

For Each varItm In ctl.ItemsSelected
strparam = strparam & "[tempImported].Product1=" & "'" & ctl.ItemData(varItm) & "'" & " OR "
Next varItm


strparam = Left(strparam, Len(strparam) - 4)
On Error GoTo start

Do While i = 0
LngCnt = LngCnt + 1
dummy = Me.Controls.Item(LngCnt).Name
Loop
start:
For i = 1 To LngCnt - 1
If UCase(Left(Me.Controls.Item(i).Name, 3)) = "chk" Then
If Me.Controls.Item(i).Value = True Then
strSQL = strSQL & ", " & Right(Me.Controls.Item(i).Name, Len(Me.Controls.Item(i).Name) - 3)
End If
End If
Next i
strSQL = strSQL & strfrom & strparam

Set dB = CurrentDb

On Error Resume Next
Set qry = dB.CreateQueryDef("qryReportGenerator", strSQL)
If Err > 0 Then
MsgBox ("You must select at least one product")
Exit Sub
End If
DoCmd.OpenQuery "qryReportGenerator"

'*************************************************
'VBA Code created by Trevor G April 2012
'*************************************************
Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strPath As String
Dim xlapp As Excel.Application
Dim ws As Excel.Worksheet

Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
DoCmd.SetWarnings False

strSQL = "SELECT * FROM qryReportGenerator"
DoCmd.SetWarnings True

rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rst.MoveFirst
Set xlapp = CreateObject("Excel.Application")
With xlapp
.Workbooks.Add
.Sheets(2).Delete
.Sheets(2).Delete
End With
xlapp.Sheets("sheet1").Select
For i = 0 To rst.Fields.Count - 1
xlapp.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
Next
xlapp.Range("a2").CopyFromRecordset rst
xlapp.Columns("A:Q").EntireColumn.AutoFit
xlapp.Visible = True


rst.Close
dB.QueryDefs.Delete ("qryReportGenerator")
End Sub

 

[Trevor G]

Could the code for the select part become a Union Query based on the code I am using?