Create Query from WHERE with VB as Recordsource (1 Viewer)

[alsoascientist]

Hi All,

I am trying to create a new query through VBA that will take the SQL as a string for the fields and values required. This will create a query that will then be exported to excel.

This is a combination of a few codes that work fine themselves, however I don't seem to be able to figure out this last part! The eventual goal is to be able to export filtered data from a subform (filtered from the parent searchform) with a number of rows hidden (from checkboxes on the parent) and to remove the hidden columns and unwanted data on export.

The export works fine with just the filtered data, it's the hidden columns part I am having issues with. So far I have this:

Private Sub ExportBtn_Click()
 
On Error GoTo errHandler
Dim qdf As QueryDef
 
Me.[SearchSubForm].Form.RecordSource = BuildRept & " FROM " & "AllQuery" & BuildFilter 
'BuildRept builds the SELECT part of the SQL, AllQuery is FROM and BuildFilter creates the WHERE - these all work fine individually
 
DoCmd.DeleteObject acQuery, "qryTemp"
 
Set qdf = CurrentDb.CreateQueryDef("qryTemp", Me.[SearchSubForm].Form.RecordSource)
DoCmd.OutputTo acOutputQuery, "qryTemp", acFormatXLS, , True
 
exitHandler:
Exit Sub
 
errHandler:
If Err.Number = 7874 Then
 
Resume Next
 
Else
 
MsgBox Err.Number & " - " & Err.Description
 
Resume exitHandler
 
End If
End Sub

Any ideas would be appreciated.

 

[alsoascientist]

It's cool... just answered my own question!
All I needed was a dim as string!

Private Sub ExportBtn_Click()

On Error GoTo errHandler
 
Dim qdf As QueryDef
Dim rept As String
 
rept = BuildRept & " FROM " & "AllQuery" & BuildFilter
 
DoCmd.DeleteObject acQuery, "qryTemp"
Set qdf = CurrentDb.CreateQueryDef("qryTemp", rept)
DoCmd.OutputTo acOutputQuery, "qryTemp", acFormatXLS, , True
 
exitHandler:
Exit Sub
 
errHandler:
If Err.Number = 7874 Then
Resume Next
Else
MsgBox Err.Number & " - " & Err.Description
Resume exitHandler
End If
 
End Sub

 

[alsoascientist]

... and if anyone needs them these are the functions for the strings...

Private Function BuildRept()
Dim varFiltr As Variant
varFiltr = Null
For Each ctrl In Me.SearchSubForm.Controls
   If ctrl.ControlType = acTextBox Then
   If ctrl.ColumnHidden = False Then
      varFiltr = varFiltr & "AllQuery." & ctrl.Name & ", "
   End If
   End If
Next
     
If IsNull(varWhere) Then
varWhere = ""
Else
varFiltr = "SELECT " & varFiltr
If Right(varFiltr, 2) = ", " Then
varFiltr = Left(varFiltr, Len(varFiltr) - 2)
End If
End If
BuildRept = varFiltr
End Function

Private Function BuildFilter() As Variant
Dim varWhere As Variant
Dim varColor As Variant
Dim varItem As Variant
Dim intIndex As Integer
Const conJetDate = "\#mm\/dd\/yyyy\#"   'The format expected for dates in a JET query string.
select1 = Forms![SearchForm]![Selection1].Value
select2 = Forms![SearchForm]![Selection2].Value
select3 = Forms![SearchForm]![Selection3].Value
varWhere = Null
varColor = Null
If Me.Search1 > "" Then
varWhere = varWhere & "[" & select1 & "] LIKE ""*" & Me.Search1 & "*"" AND "
End If
If Me.Date1 > "" Then
varWhere = varWhere & "[" & select2 & "] >= " & Format(Me.Date1 + 1, conJetDate) & " AND "
End If
If Me.Date2 > "" Then
varWhere = varWhere & "[" & select2 & "] < " & Format(Me.Date2 + 1, conJetDate) & " AND "
End If
For Each varItem In Me.ListSelect.ItemsSelected
varColor = varColor & "[" & select3 & "] = """ & _
Me.ListSelect.ItemData(varItem) & """ OR "
Next
If IsNull(varColor) Then
Else
If Right(varColor, 4) = " OR " Then
varColor = Left(varColor, Len(varColor) - 4)
End If
varWhere = varWhere & "( " & varColor & " )"
End If
If IsNull(varWhere) Then
varWhere = ""
Else
varWhere = " WHERE " & varWhere
If Right(varWhere, 5) = " AND " Then
varWhere = Left(varWhere, Len(varWhere) - 5)
End If
End If
BuildFilter = varWhere
End Function