Query con più criteri di filtro dati , con clausole AND e OR

ciao Nicola,

spero di avere letto tutto ed ho visto  il post sulla sezione di xls .

qui mi sembra si  discutesse del filtro che hai  trattato con Mimmo:

http://answers.microsoft.com/it-it/office/forum/office\_2013\_release-access/query-somma-ore-e-minuti-e-query-che-filtra-i-dati/455db579-b3cb-4e6d-8c10-238375606ebf

secondo me potrebbe esseree il caso di sfruttare il filtro applicato alla form per passarlo al metodo queryTables per popolare un  file di excel, anziché creare un altra query.

Da access direi di estrarre tutte le colonne che ti servono senza manipolare post il file di  xls creato.

lo stesso per l'aggiunta della funzione somma delle ore.

Il filtro  diventa così :

Private Sub cmdFilter_Click()

Dim strFilter As String

strFilter = ""

Const concat As String = " and "

If Nz(Me.txtPozzoTipo) <> "" Then strFilter = strFilter & "PozzoTipo=" & Me.txtPozzoTipo & concat

If Nz(Me.txtDal) <> "" Then strFilter = strFilter & "del between " & CLng(Me.txtDal) & concat & CLng(Me.txtAl) & concat

If Nz(Me.cboAnno) <> "" Then strFilter = strFilter & "year(del)='" & Me.cboAnno & "'" & concat

If Nz(Me.cboCognomeNome) <> "" Then strFilter = strFilter & Me.cboCognomeNome & concat

If Len(strFilter) > 0 Then

    strFilter = Left$(strFilter, Len(strFilter) - Len(concat))

    Me.Filter = strFilter

    Me.FilterOn = True

Else

    Me.Filter = ""

    Me.FilterOn = False

End If

End Sub

il  codice di  esportazione su xls così :

Private Sub cmdEsportaExcel_Click()

Dim strSql As String

strSql = "SELECT TblPozzo.Tipo, TblPozzo.Descrizione, tblTurniIrrigazione.Del, CDate(CDbl([tempo])) as tempoOra, tblSoci.CognomeNome" & _

         " FROM tblSoci INNER JOIN (TblPozzo INNER JOIN tblTurniIrrigazione ON TblPozzo.Tipo = tblTurniIrrigazione.ID_Socio) ON tblSoci.ID_Socio = tblTurniIrrigazione.ID_Socio "

If Len(Me.Filter) <> 0 Then

    strSql = strSql & " where " & Me.Filter

End If

' Debug.Print strSql

export2XLs2 strSql

End Sub

e questo il  modulo per esportare su xls :

Option Compare Database

Option Explicit

Public Sub export2XLs2(ByVal strSql As String)

Dim xlApp      As Object

Dim wbk        As Object 'as Workbook

Dim wsh        As Object 'as Worksheet

Dim LastRow    As Long

Dim dbp        As Access.CurrentProject

Dim bool       As Boolean

Dim xlQry      As Object

 Const cstrXlClass = "Excel.Application"

 Const cstrFullName = "c:\prova\nicola.xlsx"

 If fileExists(cstrFullName) Then Kill cstrFullName

 Const cstrCnn = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0" _

              & ";Data Source=" & cstrFullName _

              & ";Mode=Read;"

Dim blnNotRunning      As Boolean

Dim strCnn             As String

With Application

     Set dbp = .CurrentProject

End With

strCnn = Replace(cstrCnn, cstrFullName, dbp.FullName)

blnNotRunning = getXlSinstance(xlApp, False, cstrXlClass)

With xlApp

    If blnNotRunning Then

       ' .Visible = True

       .ScreenUpdating = False

    End If

End With

If fileExists(cstrFullName) Then

    Set wbk = xlApp.Workbooks.Open(cstrFullName)

Else

    Set wbk = xlApp.Workbooks.Add

End If

Set wsh = wbk.Worksheets.Item(1)

LastRow = wsh.range("A1").end(-4121).Row '  xlDown

If LastRow = wsh.cells(wsh.cells.Rows.Count, 1).end(-4121).Row Then

    LastRow = 1

    bool = Not bool

End If

 With wsh

    Set xlQry = .QueryTables.Add(Connection:=strCnn _

                                     , Destination:=.range("A" & LastRow))

End With

With xlQry

     .CommandType = 2      ' 2 è la costante per xlCmdSql

     .CommandText = strSql

     .AdjustColumnWidth = bool

     .FieldNames = bool

     .Refresh

     .Delete

End With

With xlApp

         .displayAlerts = False

        .ScreenUpdating = True

        .Calculation = -4105 'xlAutomatic

        LastRow = LastWbkRow(wsh)

        With wsh

            .cells(2 + LastRow, 4).Value = "=SUM(d2:d" & LTrim(Str(LastRow)) & ")"

            .cells(2 + LastRow, 4).numberFormat = "hh:mm:ss"

            .range("d2:d" & LTrim(Str(LastRow))).numberFormat = "hh:mm:ss"

        End With

         wbk.SaveAs FileName:=cstrFullName

         wbk.Close SaveChanges:=True _

              , FileName:=cstrFullName

        .displayAlerts = True

End With

    MsgBox "Salvato ed esportato", vbInformation, "Avviso"

exitErrorHandler:

    Set wsh = Nothing

    Set wbk = Nothing

    xlApp.Quit

    Set xlApp = Nothing

    Exit Sub

errorHandler:

    With Err

            MsgBox "ERR#" & CStr(.Number) _

                & vbNewLine & .Description _

                , vbOKOnly Or vbCritical

     End With

     Resume exitErrorHandler

End Sub

' funzione LastWbkRow Norman David Jones

Public Function LastWbkRow(SH As Object, Optional Rng As Object, _

                        Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.cells

    End If

    On Error Resume Next

    LastWbkRow = Rng.Find(What:="*", After:=Rng.cells(1), _

                       Lookat:=2, _

                       LookIn:=-4123, _

                       SearchOrder:=1, _

                       SearchDirection:=2, _

                       MatchCase:=0).Row

    On Error GoTo 0

    If LastWbkRow < minRow Then

        LastWbkRow = minRow

    End If

End Function

Private Function getXlSinstance(xlApp As Object _

                                , isXlsRunning As Boolean _

                                , strClass As String) As Boolean

    Err.Clear

    If isXlsRunning Then

        On Error Resume Next

        Set xlApp = GetObject(, strClass)

    End If

    If xlApp Is Nothing Then

        Set xlApp = CreateObject(strClass)

    End If

    If Err <> 0 Then

        MsgBox "Qualcosa non va controlla questo l'errore:" & Err.Description, _

                vbCritical, "Attenzione!!!"

        getXlSinstance = False

    Else

        getXlSinstance = True

    End If

End Function

Private Function fileExists(strFullPath As String) As Boolean

    On Error Resume Next

    fileExists = ((GetAttr(strFullPath) And vbDirectory) = 0)

End Function

Private Function folderExists(strPath As String) As Boolean

    On Error Resume Next

    folderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)

End Function

post esportazione controlla la cartella c:\prova trovi il file con l'esportazione filtrata il file si chiama nicola.xlsx

questo il tuo database modificato.

Facci  sapere.

Ciao,Sandro.

Prova a sostituire il tuo codice con questo:

Private Sub cmdFilter_Click()

    Dim wFiltro As String

    wFiltro = ""

    If Nz(Me.txtDal) And (Me.txtAl) <> "" Then

       wFiltro = "[Del] between #" & txtDal & "# AND #" & txtAl & "#"

    End If

    If Nz(Me.cboAnno) <> "" Then

       If wFiltro = "" Then

          wFiltro = "year([Del])='" & Me.cboAnno & "'"

       Else

          wFiltro = wFiltro & " And year([Del])='" & Me.cboAnno & "'"

       End If

    End If

    If Not IsNull(Me.txtPozzoTipo) Then

       If wFiltro = "" Then

          wFiltro = "PozzoTipo = " & Me.txtPozzoTipo

       Else

          wFiltro = wFiltro & " And PozzoTipo = " & Me.txtPozzoTipo

       End If

    End If

      If Not IsNull(Me.cboCognomeNome) Then

        If wFiltro = "" Then

           wFiltro = "CognomeNome LIKE '*" & Me.cboCognomeNome & "*'"

        Else

           wFiltro = wFiltro & " And CognomeNome Like '*" & Me.cboCognomeNome & "*'"

        End If

     End If

    'If Not IsNull(fltDataNascita) Then

       'If wFiltro = "" Then

          'wFiltro = "Pe_DataNascita = #" & Format(Me.fltDataNascita, "yyyy/mm/dd") & "#"

       'Else

          'wFiltro = wFiltro & " And Pe_DataNascita = #" & Format(Me.fltDataNascita, "yyyy/mm/dd") & "#"

       'End If

    'End If

    Me.Filter = wFiltro

    Me.FilterOn = True

Me.Refresh

End Sub

Ciao Mimmo