Newsgroup: it.comp.appl.access
Titolo: recodset in loop lunghetto

Salve a tutti 
devo fare dei file excel, da una query1 devo estrarre dei centri di
costo e da ogni centro di costo mandare in esterno un excel con i dati
a lui riferiti alla query2
con questo scritto speravo di mandare tutta la query2 a tutti quelli
della query1 ma continua ad mandare in continuazione oltre al numero
selezionato da query1
qualche consiglio?
strSQL1 = "SELECT * FROM [query1] "
strSQL1 = strSQL1 & " ORDER BY [ID1] "
strSQL = "SELECT * FROM [query2] "
strSQL = strSQL & " ORDER BY [ID2] "
Set db = CurrentDb
Set rst1 = db.OpenRecordset(strSQL1, dbOpenSnapshot)
'primo ciclo
Do Until rst1.EOF
Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
intRow = 5
appExcel.Application.Visible = True
appExcel.WindowState = xlMaximized 'Massimizza la finestra
Set appWorkBook = appExcel.Workbooks.Add
Set wskWorkBook = appWorkBook.Worksheets(2)
    With wskWorkBook
         Do Until rst.EOF'secondo ciclo
            .Cells(intRow, 3).Value = rst!mission
            .Cells(intRow, 4).Value = rst!politiche
            .Cells(intRow, 5).Value = rst!strategie
            rst.MoveNext
            intRow = intRow + 1
        Loop
    End With
  wskWorkBook.SaveAs FileName:="C:\Documenti\Prova.xls",
FileFormat:=xlNormal
 
 rst1.MoveNext
  Loop

 wrote in message
news:13e66d48.0405...@posting.google.com

Premesso che nel tuo caso devi fare un JOIN tra le 2 Query
non ha senso fare quel lavoro.
Prova acomporti la NUOVA Query inserendo QRY1 e QRY2 unite
in JOIN dove le proprietà del JOIN saranno =1.
Quì ora devi avere perforza quello che serve.
Poi come gestire il tutto io ti allego una semplificazione
di quello che hai fatto tu(sostanzialmente è uguale, ma tecnicamente
più raffianto e sopprattutto FLESSIBILE)
Se devi cambiare WorkSheet ti basta inserirlo nel Ciclo
ad incremento....!!!
In EXCEL le Celle possono essere Battezzate, cioè puoi dargli
un Nome.
Questo nome se "Casualmente" è = al nome del Field del Recordset
ti semplifica enormemente la vita in quanto non devi sapere dov'è
ma basta chiamarla.
Ti passo una Routine che ho fatto per compilare i campi
con Dati estratti da un RECORDSET DAO.
Ovviamente se devi limitare il numero di Campi(Fields da passare
ti basta esplicitarli nella "SELECT Campo1,Campo2,Campo3 FROM...."
Public Sub Compila()
    On Error GoTo Err_Compila
    Dim rs As DAO.Recordset
    Dim fld As DAO.Field
    Dim nme As Excel.Name
    DoCmd.Hourglass True
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM tuaTABELL WHERE
[IDX]=" & IDPROGR)
    Set xlsApp = CreateObject("Excel.Application")
    xlsApp.Application.Workbooks.Open FileName:=txtNomeFile,
Editable:=True
    Set xlsActiveWkb = xlsApp.Application.ActiveWorkbook
 
    For Each fld In rs.Fields             ' Ciclo sull'insieme Fields
del recordset
      For Each nme In xlsActiveWkb.Names  ' Ciclo sull'insieme Names
della cartella attiva
        If fld.Name = nme.Name Then       ' Se il nome campo è uguale al
nome di Name
           With xlsActiveWkb.Worksheets(1).Range(nme.Name)
            '.Select                      'Seleziono la cella
            .Value = fld.Value            'Ci scrivo il Value del field
del recordset
          End With
        End If
      Next nme
    Next fld
    xlsActiveWkb.Save
    xlsApp.Application.Visible = True
    rs.close
    Set rs = Nothing
Exit_Here:
   DoCmd.Hourglass False
   Exit Sub
Err_Compila:
   MsgBox "E' avvenuto il seguente Errore: " & vbCrLf & _
            err.Description, vbCritical, "OLE Error!"
   Resume Exit_Here
Ciao.
@Alex
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG

 ha scritto nel messaggio
news:e53651f7cdb6283bf7...@mygate.mailgate.org...

Ehmm.. Io ci aggiungerei:
... (dichiarazioni)
Dim xlsApp As Exel.Application, xlsActiveWkb As Excel.Workbook
... (codice)
Exit_Here:
   DoCmd.Hourglass False
    xlsActiveWkb.Save '<-- l'ho spostato qui
    xlsApp.Application.Visible = True '<-- l'ho spostato qui
    rs.close  '<-- l'ho spostato qui
    Set rs = Nothing '<-- l'ho spostato qui
    set fld = nothing
    set nme = nothing
   Exit Sub
Ciao.
-- 
Sergio MAZZA

 Ciao.
Che devo dire non fà na piega.... ma da me in caso d'errore
non deve salvare(ANZI)...il RECORDSET confermo è proprio una bella
svista
la dichiarazione dell'Oggetto è esterna alla Function
e viene chiuso in caso d'errore quindi non mi serve renderlo
Visibile....!!
Ciao.
@Alex. 


 @Alex.
Vabbé va, uno pari palla al centro...
Ciao.
-- 
Sergio MAZZA

 Sergio MAZZA
No, hai visto bene tu, è sicuramente da ottimizzare....!
@Alex.

premesso che sono rimasta stupita della mole di lavoro e suggerimenti
che mi avete mandato, non posso měnascondre he mi  č voluta tutta la
sera per leggere con un pň di attenzione tutto...e sicuramente tutto
domani srň impegnata a provarlo vi farň sapere i risultati grazie di
cuore e buona notte
elisa

 elisa
Eddai Alessà, pure stavolta avemo fatto colpo!
Hi! Hi! Due settimane così e il Biso è detronizzato...
Ciao.
-- 
Sergio MAZZA

 wrote in message
news:d4Yqc.215212$
hc5.9...@news3.tin.it

Non gridarlo troppo o inveisce e ci manda ANATEMI...!!!
Sai che ha 100 occhi per queste faccende di "CODICE".
