Access Query Help - List box (1 Viewer)

C

china99boy

Registered User.
Local time
Today, 17:28
Joined
Apr 27, 2006
Messages
161
Hi all, I currently have a form that asked the user for the date and it would query my results. But I just added a list box as one of the requirements. From the list box the user can select more than one item from the list. When I added the information in the query to reference the list box I recieve an error "Item not found in this collection. The only line I added was
Code: 
qd.Parameters![lstBranchNo] = [Forms]![frmMonthEndRpt]![lstBranchNo]
What would I need to change so that the user can select the date range along with multiple items from the list box? Thanks in advance.


Code: 
Public Function ExportRequest() As String
         
   ' Excel object variables
   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet
   
   Dim sTemplate As String
   Dim sTempFile As String
   Dim sOutput As String
   
   Dim dbs As DAO.Database
   Dim rst As DAO.Recordset
   Dim qd As DAO.QueryDef ' Added 10/06/07
   Dim sSql As String
   Dim lRecords As Long
   Dim iRow As Integer
   Dim iCol As Integer
   Dim iFld As Integer
   Dim strMacroName As String
   Dim strMacroName2 As String
   Dim strMacroName3 As String
   Dim strFileName As String

   strMacroName = "DeleteBlank"
   strMacroName2 = "AutoFitAll"
   strMacroName3 = "SetPrintArea"
   strFileName = "R:\AOOutput.xls"
     
   Const cTabOne As Byte = 1
   Const cStartRow As Byte = 4
   Const cStartColumn As Byte = 1
   
   DoCmd.Hourglass True
   
   ' set to break on all errors
   Application.SetOption "Error Trapping", 0
   
   ' start with a clean file built from the template file
   
   sTemplate = "R:\AOTemplate.xls"
   sOutput = "R:\\AOOutput.xls"
   If Dir(sOutput) <> "" Then Kill sOutput
   FileCopy sTemplate, sOutput
      
   ' Create the Excel Applicaiton, Workbook and Worksheet and Database object
   Set appExcel = Excel.Application
   Set wbk = appExcel.Workbooks.Open(sOutput)
   Set wks = appExcel.Worksheets(cTabOne)
         
   sSql = "select * from qryAOSummary"
   Set dbs = CurrentDb
   
   Set qd = dbs.QueryDefs("qryAOSummary")
   
   qd.Parameters![txtStartDate] = [Forms]![frmMonthEndRpt]![txtStartDate]
   qd.Parameters![txtEndDate] = [Forms]![frmMonthEndRpt]![txtEndDate]
   qd.Parameters![lstBranchNo] = [Forms]![frmMonthEndRpt]![lstBranchNo]
   
   Set rst = qd.OpenRecordset
   If Not rst.BOF Then rst.MoveFirst
   
   ' For this template, the data must be placed on the 4th row, third column.
   ' (these values are set to constants for easy future modifications)
   iCol = cStartColumn
   iRow = cStartRow


   Do Until rst.EOF
      iFld = 0
      lRecords = lRecords + 1
      Me.lblMsg.Caption = "Exporting record #" & lRecords & " to AoOutput.xls"
      Me.Repaint
      
      For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
         wks.Cells(iRow, iCol) = rst.Fields(iFld)
         
         If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
            wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
         End If
         
         wks.Cells(iRow, iCol).WrapText = False
         iFld = iFld + 1
      Next
      
      wks.Rows(iRow).EntireRow.AutoFit
      iRow = iRow + 1
      rst.MoveNext
   Loop
   
    ExportRequest = "Total of " & lRecords & " rows processed."
   Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."
   
'Inserts Month,Year format based on entry in start date field.
wks.Range("A2").Value = [Forms]![frmMonthEndRpt]![txtStartDate]

'The Application.Run will run the Macro(s) that you saved in your spreadsheet
wks.Application.Run "'" & strFileName & "'!" & strMacroName
wks.Application.Run "'" & strFileName & "'!" & strMacroName2

      
exit_Here:
   ' Cleanup all objects  (resume next on errors)
   
   On Error Resume Next
   Set wks = Nothing
   Set wbk = Nothing
   Set rst = Nothing
   Set dbs = Nothing
   DoCmd.Hourglass False
   Exit Function
    
End Function
 
C

china99boy

Registered User.
Local time
Today, 17:28
Joined
Apr 27, 2006
Messages
161
Thanks so much for the link. I tried my best to incorporate the information from the other site, but still coming up short. I am still getting the error "Item not found in this collection" and debugging at the highlighted area below. Can someone point me in the right direction. The user should select a date range and select one or more branch# from the listbox or none to display all records. The listbox is tied to a number field in the tblLoanTracking.ENTERBY. Everything worked well before I add the listbox.

Thanks again for the help on this.

Code: 
Public Function ExportRequest() As String


   ' Excel object variables
   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet
   
   Dim sTemplate As String
   Dim sTempFile As String
   Dim sOutput As String
   
   Dim dbs As DAO.Database
   Dim rst As DAO.Recordset
   Dim qd As DAO.QueryDef ' Added 10/06/07
   Dim sSql As String
   Dim lRecords As Long
   Dim iRow As Integer
   Dim iCol As Integer
   Dim iFld As Integer
   Dim strMacroName As String
   Dim strMacroName2 As String
   Dim strMacroName3 As String
   Dim strFileName As String

   strMacroName = "DeleteBlank"
   strMacroName2 = "AutoFitAll"
   strMacroName3 = "SetPrintArea"
   strFileName = "R:\Center\Remote Branches\Loan Statistical\AOOutput.xls"
     
   Const cTabOne As Byte = 1
   Const cStartRow As Byte = 4
   Const cStartColumn As Byte = 1
   
   DoCmd.Hourglass True
   
   ' set to break on all errors
   Application.SetOption "Error Trapping", 0
   
   ' start with a clean file built from the template file
   
   sTemplate = "R:\Center\Remote Branches\Loan Statistical\AOTemplate.xls"
   sOutput = "R:\Center\Remote Branches\Loan Statistical\AOOutput.xls"
   If Dir(sOutput) <> "" Then Kill sOutput
   FileCopy sTemplate, sOutput
   
   
   ' Create the Excel Applicaiton, Workbook and Worksheet and Database object
   Set appExcel = Excel.Application
   Set wbk = appExcel.Workbooks.Open(sOutput)
   Set wks = appExcel.Worksheets(cTabOne)
         
   sSql = "select * from qryAOSummary"
   Set dbs = CurrentDb
   
   Set qd = dbs.QueryDefs("qryAOSummary")
   
   [COLOR="red"]qd.Parameters![txtStartDate] = [Forms]![frmMonthEndRpt]![txtStartDate][/COLOR]   
  qd.Parameters![txtEndDate] = [Forms]![frmMonthEndRpt]![txtEndDate]
   
   ' Loop through the selected items in the list box and build a text string
    For Each varItem In Me!lstBranchNo.ItemsSelected
        strCriteria = strCriteria & ",'" & Me!lstBranchNo.ItemData(varItem) & "'"
    Next varItem
' Check that user selected something
    If Len(strCriteria) = 0 Then
        MsgBox "You did not select anything from the list" _
            , vbExclamation, "Nothing to find!"
    
    End If
' Remove the leading comma from the string
    strCriteria = Right(strCriteria, Len(strCriteria) - 1)
' Build the new SQL statement incorporating the string
    sSql = "SELECT * FROM tblLoanTracking " & _
             "WHERE tblLoanTracking.ENTERBY IN(" & strCriteria & ");"
' Apply the new SQL statement to the query
    qd.SQL = sSql
    
   Set rst = qd.OpenRecordset
   If Not rst.BOF Then rst.MoveFirst
   
   ' For this template, the data must be placed on the 4th row, third column.
   ' (these values are set to constants for easy future modifications)
   iCol = cStartColumn
   iRow = cStartRow


   Do Until rst.EOF
      iFld = 0
      lRecords = lRecords + 1
      Me.lblMsg.Caption = "Exporting record #" & lRecords & " to AoOutput.xls"
      Me.Repaint
      
      For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
         wks.Cells(iRow, iCol) = rst.Fields(iFld)
         
         If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
            wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
         End If
         
         wks.Cells(iRow, iCol).WrapText = False
         iFld = iFld + 1
      Next
      
      wks.Rows(iRow).EntireRow.AutoFit
      iRow = iRow + 1
      rst.MoveNext
   Loop
   
    ExportRequest = "Total of " & lRecords & " rows processed."
   Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."
   
'Inserts Month,Year format based on entry in start date field.
wks.Range("A2").Value = [Forms]![frmMonthEndRpt]![txtStartDate]

'The Application.Run will run the Macro(s) that you saved in your spreadsheet
wks.Application.Run "'" & strFileName & "'!" & strMacroName
wks.Application.Run "'" & strFileName & "'!" & strMacroName2

      
exit_Here:
   ' Cleanup all objects  (resume next on errors)
   
   On Error Resume Next
   Set wks = Nothing
   Set wbk = Nothing
   Set rst = Nothing
   Set dbs = Nothing
   DoCmd.Hourglass False
   Exit Function
    
End Function
 
C

china99boy

Registered User.
Local time
Today, 17:28
Joined
Apr 27, 2006
Messages
161
Hi all, I am still trying to get this to work. I made some changes to my approach but still coming up with errors. I am currently get a Run-Time error 3061 - Too few parameters. Expected 3. It debugs at "Set rst = qd.recordset"

I left my previous query (qryAOSummary) as it was and created a new query (qryAOSummary_Filtered) and defined its SQL as "SELECT * FROM qryAOSummary;"

this is my code as it is right now. Where am I going wrong?

Public Function ExportRequest() As String

' Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet

Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qd As DAO.QueryDef ' Added 10/06/07
Dim sSql As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer
Dim strMacroName As String
Dim strMacroName2 As String
Dim strMacroName3 As String
Dim strFileName As String

Dim varItem As Variant
Dim strInClause As String


strMacroName = "DeleteBlank"
strMacroName2 = "AutoFitAll"
strMacroName3 = "SetPrintArea"
strFileName = "R:\Center\AOOutput.xls"

Const cTabOne As Byte = 1
Const cStartRow As Byte = 4
Const cStartColumn As Byte = 1

DoCmd.Hourglass True

' set to break on all errors
Application.SetOption "Error Trapping", 0

' start with a clean file built from the template file
sTemplate = "R:\Center\AOTemplate.xls"
sOutput = "R:\Center\AOOutput.xls"
If Dir(sOutput) <> "" Then Kill sOutput
FileCopy sTemplate, sOutput


' Create the Excel Applicaiton, Workbook and Worksheet and Database object
Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(sOutput)
Set wks = appExcel.Worksheets(cTabOne)

sSql = "select * from qryAOSummary"
Set dbs = CurrentDb

Set qd = dbs.QueryDefs("qryAOSummary")

qd.Parameters![txtStartDate] = [Forms]![frmMonthEndRpt]![txtStartDate]
qd.Parameters![txtEndDate] = [Forms]![frmMonthEndRpt]![txtEndDate]

If Me!lstBranchNo.ItemsSelected.Count = 0 Then
MsgBox ("Please select at least one Branch#.")
Else
strInClause = "[ENTERBY] IN ("
For Each varItem In Me!lstBranchNo.ItemsSelected
strInClause = strInClause & """" & Me!lstBranchNo.Column(0, varItem) & """" & ","
Next varItem
strInClause = Left(strInClause, Len(strInClause) - 1) & ")"
End If

CurrentDb.QueryDefs("qryAOSummary_Filtered").SQL = "SELECT * FROM qryAOSummary " & _
"WHERE " & strInClause & ";"

Set rst = qd.OpenRecordset
If Not rst.BOF Then rst.MoveFirst

' For this template, the data must be placed on the 4th row, third column.
' (these values are set to constants for easy future modifications)
iCol = cStartColumn
iRow = cStartRow


Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1
Me.lblMsg.Caption = "Exporting record #" & lRecords & " to AoOutput.xls"
Me.Repaint

For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iRow, iCol) = rst.Fields(iFld)

If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
End If

wks.Cells(iRow, iCol).WrapText = False
iFld = iFld + 1
Next

wks.Rows(iRow).EntireRow.AutoFit
iRow = iRow + 1
rst.MoveNext
Loop

ExportRequest = "Total of " & lRecords & " rows processed."
Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."

'Inserts Month,Year format based on entry in start date field.
wks.Range("A2").Value = [Forms]![frmMonthEndRpt]![txtStartDate]

'The Application.Run will run the Macro(s) that you saved in your spreadsheet
wks.Application.Run "'" & strFileName & "'!" & strMacroName
wks.Application.Run "'" & strFileName & "'!" & strMacroName2


exit_Here:
' Cleanup all objects (resume next on errors)

On Error Resume Next
Set wks = Nothing
Set wbk = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function

End Function
 
You must log in or register to reply here.

Similar threads

K
Multi Select List Box to a query
Replies
3
Views
543
Kass
K
C
Multi-Select Issue
Replies
1
Views
874
china99boy
C
K
Excel Automation - Blank worksheet/file
Replies
2
Views
1,337
Kevin Robson
K
J
Updating Excel Worksheet from Access
Replies
1
Views
1,082
SpentGeezer
SpentGeezer
C
Excel partially visiable
Replies
1
Views
1,051
zazi69
Z

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom