VBA to Filter Query using Parameter and Export for Distinct Parameters

Question

VBA to Filter Query using Parameter and Export for Distinct Parameters

Anonymous

Hello!

I've got a database that has a series of queries that do some aggregation and transformation of data. I'd like to run some code to output the final query, "Book of Business" for each distinct "Broker Firm Name".

The "Book of Business" query has a Parameter defined (Used to filter the query) as follows:

PARAMETERS BrokerFirmParameter Text ( 255 );

Here is what I've got so far on my code for the button to execute the saving of the separate files:

Dim rs As DAO.Recordset

Dim sFolder As String

Dim sBrokerFirm As String

Dim sFile As String

Dim sParameter As String

Const sQueryName = "Book of Business"

Dim tblDef As DAO.TableDef

sFolder = Application.CurrentProject.Path & "\Reports"

Set rs = CurrentDb.OpenRecordset("SELECT DISTINCT [Company Name] FROM [Broker Firm List];", dbOpenSnapshot)

With rs

If .RecordCount &lt;&gt; 0 Then 

    .MoveFirst 

    Do While Not .EOF 

        sBrokerFirm = Nz(![Company Name], "") 

        sFile = sFolder & sBrokerFirm & ".xlsx" 

        sParameter = Nz(![Company Name], "") 

        DoCmd.SetParameter "BrokerFirmParameter", sParameter 

        DoCmd.OpenQuery sQueryName, acViewNormal, acReadOnly 

        DoCmd.OutputTo acOutputQuery, sQueryName, acFormatXLSX, sFile, , , , acExportQualityPrint 

        DoCmd.Close acQuery, sQueryName 

        .MoveNext 

    Loop 

End If

End With

There are error handling items as well.

The DoCmd.SetParameter line above fails:

Run-time error '2434':

The expression you entered contains invalid syntax.

If I suppress it, I get a manual entry prompt to submit the "BrokerFirmParameter". Doing so will result in everything working EXCEPT for the filtering of data (the Excel file is created, but there are no rows on it), then moving to the next record attempt triggering another prompt for the Parameter.

Can anyone tell me what I'm missing? The line's syntax appears to be correct to me.

Thanks!

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

Answer accepted by question author

3 additional answers

Answer 1

An alternative approach, rather than referencing parameters, would be to concatenate the values of the parameters into an SQL statement, and then use this as the basis for exporting the result table to Excel. To concatenate the parameters' values into the string expression, in a developed application they would usually be references to controls on a dialogue form, but a cheap and cheerful solution equivalent to a simple parameter prompt would be to call the InputBox function for each parameter.

The following is a function which will export the result table of an SQL statement to Excel. The function is an old one and calls Bill Wilson's BrowseForFileClass class module. These days we'd use the FileDialog property of the Application object of course. Bill's module should still work, however, so I've included its code at the end of this reply.

Public Function ExportSQLToExcel(strSQL As String)

Const MESSAGETEXT = "Overwrite existing file?"

Dim OpenDlg As New BrowseForFileClass

Dim strExportTo As String

Dim qdf As DAO.QueryDef

OpenDlg.DialogTitle = "Select File"

strExportTo = OpenDlg.GetFileSpec

Set OpenDlg = Nothing

' delete temporary querydef object if exists

On Error Resume Next

CurrentDb.QueryDefs.Delete "qryTemp~"

Select Case Err.Number

Case 0

' no error

Case 3265

' temporary querydef does not exist

' ignore error

Case Else

' unknown error

MsgBox Err.Number, vbExclamation, "Error"

Exit Function

End Select

' create temporary querydef object

Set qdf = CurrentDb.CreateQueryDef("qryTemp~")

CurrentDb.QueryDefs("qryTemp~").SQL = strSQL

If strExportTo <> "" Then

If Dir(strExportTo) <> "" Then

If MsgBox(MESSAGETEXT, vbQuestion + vbYesNo, "Confirm") = vbNo Then

Exit Function

Else

Kill strExportTo

End If

Else

Exit Function

End If

DoCmd.TransferSpreadsheet _

TransferType:=acExport, _

TableName:="qryTemp~", _

FileName:=strExportTo

' delete temporary querydef object

CurrentDb.QueryDefs.Delete "qryTemp~"

End Function

Here's Bill's module:

Option Compare Database

Option Explicit

' Thanks are due to Bill Wilson for permission for this module to be

' distributed and used freely (KWS)

' Note: This module is a modified copy of part of the modRefreshLinks

' module in the Solutions database that is supplied with Access.

'

' That module in the Solutions database contains a lot of descriptive

' comments about the OPENFILENAME data structure that is used below, and

' it contains definitions for a list of constants that can be used in the

' Flags field in the OPENFILENAME data structure.

'

' This version was created by Bill Wilson in January 1999.

' E-mail: ******@bigfoot.com

' Modified by Ken Sheridan, May 1999 to allow multiple 'additional types'

'

' The purpose of this class is to activate a dialog box that the User will

' use to pick out a particular file. The VBA code that uses this class can

' either use it to open a file or to just save the complete path and filename

' for a file which will be used at some future time.

'

' NB The dialog does not actually open the file. It only returns the path

' to the file for use in code (comment added by KWS).

'

' There are default values for the dialog box title and the list of file types

' in the 'file filter' section of the dialog box. The calling VBA code can

' use the following Properties and Methods of this class.

'

' Properties:

' DialogTitle -- the text that is displayed as the title of the

' dialog box. The default is "Browse For a File".

' AdditionalTypes -- one or more additional file types to be added as

' one item in the dialog box's file filter list,

' formatted like this sample:

' "My Files (*.mf1;*.mf2) | *.mf1;*.mf2 | Your Files (*.yf1;*.yf2) *.yf1;*.yf2"

' The following file types are in the built-in list:

' "All Files (*.*)"

' "Text Files (*.txt;*.prn;*.csv)"

' "Word Documents (*.doc)"

' "Word Templates (*.dot)"

' "Rich Text Files (*.rtf)"

' "Excel Files (*.xls)"

' "Databases (*.mdb)"

' "HTML Documents (*.html;*.htm)"

' DefaultType -- the item in the dialog's file filter list that will be

' active when the dialog box is activated. If the

' AdditionalTypes property is not used, the default

' is "All files (*.*)". If the AdditionalTypes property

' is used, this property cannot be used and the file type

' specified in the AdditionalTypes property will be active

' when the dialog box is activated. To set this property,

' specify a string that will match with the desired type,

' such as "*.doc" or "HTML".

' InitialFile -- the file name that is to be displayed in the File Name

' field in the dialog box when it is activated. The

' default is to leave the File Name field blank.

' InitialDir -- the directory/folder which should be active when the

' dialog box is activated. The default is the current

' directory.

'

' Methods:

' GetFileSpec() -- this function activates the dialog box and then returns

' the full path and filename of the file that the User

' has selected. If the User clicks Cancel, a zero

' length string is returned.

'

Private Type OPENFILENAME

lStructSize As Long

hwndOwner As Long

hInstance As Long

lpstrFilter As String

lpstrCustomFilter As Long

nMaxCustrFilter As Long

nFilterIndex As Long

lpstrFile As String

nMaxFile As Long

lpstrFileTitle As String

nMaxFileTitle As Long

lpstrInitialDir As String

lpstrTitle As String

Flags As Long

nFileOffset As Integer

nFileExtension As Integer

lpstrDefExt As String

lCustrData As Long

lpfnHook As Long

lpTemplateName As Long

End Type

Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _

"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Private strDialogTitle As String

Private intDefaultType As Integer

Private strNewTypes As String

Private strInitialFile As String

Private strInitialDir As String

Private strFilter As String

Private strFltrLst As String

Private strFltrCnt As String

' This 'Method' routine displays the Open dialog box for the user to

' locate the desired file. Returns the full path to the file.

'

Public Function GetFileSpec()

Dim of As OPENFILENAME

Dim intRet As Integer

'set up the file filter and the default type option

If strNewTypes <> "" Then

of.lpstrFilter = strNewTypes & strFilter

of.nFilterIndex = 1

Else

of.lpstrFilter = strFilter

If intDefaultType <> 0 Then

of.nFilterIndex = intDefaultType

Else

of.nFilterIndex = 1

End If

'define some other dialog options

of.lpstrTitle = strDialogTitle

of.lpstrInitialDir = strInitialDir

of.lpstrFile = strInitialFile & String(512 - Len(strInitialFile), 0)

of.nMaxFile = 511

' Initialize other parts of the structure

of.hwndOwner = Application.hWndAccessApp

of.hInstance = 0

of.lpstrCustomFilter = 0

of.nMaxCustrFilter = 0

of.lpfnHook = 0

of.lpTemplateName = 0

of.lCustrData = 0

of.lpstrFileTitle = String(512, 0)

of.nMaxFileTitle = 511

of.lpstrDefExt = vbNullChar

of.Flags = 0

of.lStructSize = Len(of)

'call the Open dialog routine

intRet = GetOpenFileName(of)

If intRet Then

GetFileSpec = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)

Else

GetFileSpec = ""

End If

End Function 'End of GetFileSpec

'

' The following 'Property' routines define the Dialog Box properties

'

Public Property Let DialogTitle(strTitle As String)

'store the title for the dialog box

strDialogTitle = strTitle

End Property

Public Property Let AdditionalTypes(strAddTypes As String)

Dim Posn As Integer

Dim i As Integer

'don't accept additional types if a default type has been specified

If intDefaultType <> 0 Then

MsgBox "You cannot add to the file type filter if a default type is " & _

"being specified in the DefaultType property. When the " & _

"AdditionalTypes property is used, that item " & _

"is used as the default in the file type filter.", vbCritical, _

"Browse For File Dialog"

Exit Property

End If

'check for the "|" delimiter

Posn = InStr(strAddTypes, "|")

'save the new parameter or report an error

If Posn = 0 Then

MsgBox "The AdditionalTypes property string does not contain at least " & _

"one " & Chr$(34) & "|" & Chr$(34) & " character. " & _

"You must specify an AdditionalTypes property in the same " & _

"format that is shown in the " & _

"following example: " & vbCrLf & vbCrLf & Chr$(34) & _

"My Files (*.mf1;*.mf2) | *.mf1;*.mf2 | Your Files (*.yf1;*.yf2) *.yf1;*.yf2" _

& Chr$(34), vbCritical, "Browse For File Dialog"

strNewTypes = ""

Exit Property

Else

Do While True

If InStr(1, strAddTypes, "|") Then

strNewTypes = strNewTypes & Left$(strAddTypes, _

InStr(1, strAddTypes, "|") - 1) & vbNullChar

strAddTypes = Mid$(strAddTypes, InStr(1, strAddTypes, "|") + 1)

Else

strNewTypes = strNewTypes & vbNullChar

Exit Do

End If

Loop

End If

End Property 'End of AdditionalTypes

Public Property Let DefaultType(strType As String)

Dim Posn As Integer

Posn = InStr(strFltrLst, strType)

'don't accept a default if new types are being specified

If strNewTypes <> "" Then

MsgBox "You cannot set the DefaultType property if you are using the " & _

"AdditionalTypes property to expand the file types filter. " & _

"In that case the type specified in the AdditionalTypes property " & _

"will be the default type.", vbCritical, "Browse For File Dialog"

Exit Property

'make sure the selected default actually exists

ElseIf Posn = 0 Then

MsgBox "The file type you specified in the DefaultType " & _

"property is not in the built-in " & _

"list of file types. You must either specify one of the " & _

"built-in file types or use the AdditionalTypes property " & _

"to specify a complete entry similar to the " & _

"following example: " & vbCrLf & vbCrLf & Chr$(34) & _

"My Files (*.mf) | *.mf" & Chr$(34), vbCritical, _

"Browse For File Dialog"

Exit Property

Else

'set up the selected default

intDefaultType = Trim$(Mid$(strFltrCnt, Posn, 3))

End If

End Property

Public Property Let InitialFile(strIFile As String)

strInitialFile = strIFile

End Property

Public Property Let InitialDir(strIDir As String)

strInitialDir = strIDir

End Property

' This routine initializes the string constants that are used by this class

'

Private Sub Class_Initialize()

'define some initial conditions

strDialogTitle = "Browse For a File"

strInitialDir = ""

strInitialFile = ""

strNewTypes = ""

'define the filter string and the look-up strings

strFilter = "All Files (*.*)" & vbNullChar & "*.*" & vbNullChar & _

"Text Files (*.txt;*.prn;*.csv)" & vbNullChar & "*.txt;*.prn;*.csv" & vbNullChar & _

"Word Documents (*.doc)" & vbNullChar & "*.doc" & vbNullChar & _

"Word Templates (*.dot)" & vbNullChar & "*.dot" & vbNullChar & _

"Rich Text Files (*.rtf)" & vbNullChar & "*.rtf" & vbNullChar & _

"Excel Files (*.xls)" & vbNullChar & "*.xls" & vbNullChar & _

"Databases (*.mdb;*.accdb)" & vbNullChar & "*.mdb;*.accdb" & vbNullChar & _

"Personal Document Format (*.pdf)" & vbNullChar & "*.pdf" & vbNullChar & _

"HTML Documents (*.html;*.htm)" & vbNullChar & "*.html;*.htm" & vbNullChar

strFltrLst = "*.* *.txt *.prn *.csv *.doc *.dot *.rtf *.xls *.mdb *.accdb *.pdf *.html *.htm"

strFltrCnt = " 1 2 2 2 3 4 5 6 7 7 8 9 9"

End Sub

Answer 2

Thank you to everyone who replied!

I kept working at it and wound up putting a hidden text box on a form and passed the parameter over to that field. Then I added that form control as a filter item and parameter in the query design.

That did the trick, but I'm going to explore the other options listed here as well to see if I can get it to be "cleaner".

Answer 3

DBG 11,711 Volunteer Moderator

If you were going to use VBA, I would suggest you try doing it without relying on DoCmd object. For example, you can use a Query Def object to pass the parameters, and you can use Excel automation with the CopyFromRecordset to export the data.

Just a thought...

0 comments

Answer 4

Duane Hookom 26,820 Volunteer Moderator

I would remove the parameter and use this function to modify the SQL of the saved query.

0 comments

Share via

VBA to Filter Query using Parameter and Export for Distinct Parameters

3 additional answers