[VBA] Esportazione in Excel da Access con date

[kingkkk]

Buongiorno a tutti gli utenti del forum,
anticipo che ho un problema a confrontare i campi data da Access.Ecco cosa ho in mente.sto progettando una routine che
esporti un reordset da acces, generato da una query nel codice vba, in un foglio excel. Alcuni campi della query sono date e la
selezione dei record ha come parametro una data immessa in una casella testo di una macshera. Apro la maschera, immetto
la data parametro su cui effettuare la query e poi voglio che mi esporti i dati in exel.
ecco il codice

Private Sub Comando4_Click()
Dim MyExcApp As Excel.Application
Dim MyExcWkb As Excel.Workbook
Dim MyExcWst As Excel.Worksheet
Dim MyQy As String
Dim Rcs1 As DAO.Recordset
Dim i As Integer
i = 0


'definisco la query che restituisce i record con una determinata data parametro nella mascera nella casella1
MyQy = "SELECT Tabella4.datai,Tabella4.dataf,Tabella4.attività FROM Tabella4 WHERE Tabella4.datai=" & Me.Casella1

'definisco questa query come reecordset
Set Rcs1 = CurrentDb.OpenRecordset(MyQy, dbOpenDynaset)

Set MyExcApp = New Excel.Application
Set MyExcWkb = MyExcApp.Workbooks.Add
Set MyExcWst = MyExcWkb.Worksheets(1) ' apriamo la nuova applicazione excel al foglio 1
' Iniziamo il loop di scrittura dei records
Do Until Rcs1.EOF
i = i + 1
With MyExcWst.Rows(i)
.Cells(, 1).Value = Format$(Rcs1.Fields("datai"), "mm/dd/yyyy")
.Cells(, 2).Value = Format$(Rcs1.Fields("dataf"), "mm/dd/yyyy")
.Cells(, 3).Value = Rcs1.Fields("attività")
End With
Rcs1.MoveNext
Loop

Rcs1.Close
MyExcApp.Visible = True

End Sub

Il problema è che questa procedura mi restituisce un foglio vuoto.
Ho provato a togliere il parametr di ricerca, in modo che esportasse tutto il recprdset così com'è,e i campi data vengono trascritti come seriali, come posso fare per inserire il parametro e farlo confrontare con
i campi data del recodset?
Ciao

[Ap13]

Ciao,
io crerei una query (es q_filtro) con il visualizzatore di access, dopo di che, sull'evento click

 Sub EsportaXls(NomeQueryDaesportare As String, NomeFileEsportato As String, NomeFoglio As String)
    Dim percorso As String
    percorso = Application.CurrentProject.Path & "\" & NomeFileEsportato & ".xls"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, NomeQueryDaesportare, percorso, True, NomeFoglio
 
 End Sub

[Ap13]

Ciao,
io crerei una query (es q_filtro) con il visualizzatore di access, dopo di che, sull'evento click

 Sub EsportaXls(NomeQueryDaesportare As String, NomeFileEsportato As String, NomeFoglio As String)
    Dim percorso As String
    percorso = Application.CurrentProject.Path & "\" & NomeFileEsportato & ".xls"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, NomeQueryDaesportare, percorso, True, NomeFoglio
 
 End Sub

[kingkkk]

Grazie ap, l'avevo pensato anch'io in seguito e l'avevo già risolto in questo modo.
il problema successivo e che adesso il fogli oexcel ha un bel pò di roba proveniente da più fonti ed ho bisogno di riordinare in base a dei valori di una colonna.
ho anche implementato l'algoritmo di riordini con un ciclo do until, e funziona tutto, almeno alla prima attivazione. nelle successivr mi restituisce sempre un errore metodo cells dell'oggetto global non riuscito. Mi spiego, il trasferimento e il riordino viene fatto bene solo alla prima interrogazione, nelle successive si pianta.
ecco il codice

With ExWs
Do Until (n = h + 1)
  .Cells(h + 1, 1).Value = .Cells(n, 1).Value
  .Cells(h + 1, 2).Value = .Cells(n, 2).Value
  .Cells(h + 1, 3).Value = .Cells(n, 3).Value
  .Cells(h + 1, 4).Value = .Cells(n, 4).Value
  Do Until (z = h + 1)
  If .Cells(z, 1).Value < .Cells(h + 1, 1) Then
    .Cells(h + 2, 1).Value = .Cells(h + 1, 1).Value ' alla prima query risponde bene...
    .Cells(h + 2, 2).Value = .Cells(h + 1, 2).Value ' ...ma alla seconda come al solito
    .Cells(h + 2, 3).Value = .Cells(h + 1, 3).Value
    .Cells(h + 2, 4).Value = .Cells(h + 1, 4).Value
    .Cells(h + 1, 1).Value = Cells(z, 1).Value ' e qui mi dà l'errore metodo cells global
    .Cells(h + 1, 2).Value = Cells(z, 2).Value
    .Cells(h + 1, 3).Value = Cells(z, 3).Value
    .Cells(h + 1, 4).Value = Cells(z, 4).Value
    .Cells(n, 1).Value = .Cells(h + 1, 1).Value
    .Cells(n, 2).Value = .Cells(h + 1, 2).Value
    .Cells(n, 3).Value = .Cells(h + 1, 3).Value
    .Cells(n, 4).Value = .Cells(h + 1, 4).Value
    .Cells(z, 1).Value = .Cells(h + 2, 1).Value
    .Cells(z, 2).Value = .Cells(h + 2, 2).Value
    .Cells(z, 3).Value = .Cells(h + 2, 3).Value
    .Cells(z, 4).Value = .Cells(h + 2, 4).Value
  End If
  z = z + 1
  Loop
z = n + 1
n = n + 1
Loop
.Cells(h + 1, 1).Value = ""
.Cells(h + 1, 2).Value = ""
.Cells(h + 1, 3).Value = ""
.Cells(h + 1, 4).Value = ""
.Cells(h + 2, 1).Value = ""
.Cells(h + 2, 2).Value = ""
.Cells(h + 2, 3).Value = ""
.Cells(h + 2, 4).Value = ""
End With ' fine riordino

[Ap13]

Ciao,
Non ho ben capito il tuo problema.
In ogni caso mi pare che l'errore cells global si manifesti quando non è stato specificato il foglio su cui lavorare o si sta lavorando su due oggetti xls
Nella parte in verde non mancano i punti dopo l'uguale?

If .Cells(z, 1).Value < .Cells(h + 1, 1) Then
    .Cells(h + 2, 1).Value = .Cells(h + 1, 1).Value ' alla prima query risponde bene...
    .Cells(h + 2, 2).Value = .Cells(h + 1, 2).Value ' ...ma alla seconda come al solito
    .Cells(h + 2, 3).Value = .Cells(h + 1, 3).Value
    .Cells(h + 2, 4).Value = .Cells(h + 1, 4).Value
    .Cells(h + 1, 1).Value = Cells(z, 1).Value ' e qui mi dà l'errore metodo cells global
    .Cells(h + 1, 2).Value = Cells(z, 2).Value
    .Cells(h + 1, 3).Value = Cells(z, 3).Value
    .Cells(h + 1, 4).Value = Cells(z, 4).Value 
      .Cells(n, 1).Value = .Cells(h + 1, 1).Value
    .Cells(n, 2).Value = .Cells(h + 1, 2).Value
    .Cells(n, 3).Value = .Cells(h + 1, 3).Value
    .Cells(n, 4).Value = .Cells(h + 1, 4).Value
    .Cells(z, 1).Value = .Cells(h + 2, 1).Value
    .Cells(z, 2).Value = .Cells(h + 2, 2).Value
    .Cells(z, 3).Value = .Cells(h + 2, 3).Value
    .Cells(z, 4).Value = .Cells(h + 2, 4).Value
  End If

ciao