CICLO DO WHILE PER LA COMPILAZIONE DI UNA TABELLA ALL'INTERNO DI UNA EMAIL

Anonimo
2023-07-17T18:43:46+00:00

Buonasera a tutti

sono alle prese con un piccolo dbase di access ed ho realizzato una query con l'estrazione di dati di cui alcuni di essi da utilizzare come tabella inserita all'interno di un testo email. E' da termpo che utilizzo access ma non mi sono mai avvalso della funzione do while, credo che adesso sia il caso di utlizzarla.

Vi riporto uno schema della tabella che vorrei realizzare all'interno del testo email:

id_anagrafica num_scheda Importo_lordo Tot_ritenute Importo_netto
1 AB_123_2023 500,00 100,00 400,00
1 AB_124_2023 350,00 50,00 300,00
1 AB_125_2023 100,00 20,00 80,00

Ho impostato il codice per la creazione dell'email che vi riporto qui di seguito:

Dim OutApp As Object

Dim OutMail As Object

Dim strMsg As String

Dim strDest As String

Dim strDirettore As String

Dim Oggetto As String

Dim Num_scheda As String

Dim Anno_Liquidazione As String

Dim Det_liquidazione As String

Dim Importo_lordo As String

Dim Tot_Ritenute As String

Dim Importo_netto As String

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)  'crea nuova email

strDest = DLookup("email", "Anagrafica", "ID_Anagrafica=" & Me!id_anagrafica)

'strDirettore = DLookup("email_rup", "Servizio", "ID_servizio=" & Me!id_servizio)

strCognomeNome = DLookup("Cognome_Nome", "Qry_Riepilogo_generale_Schede_liquidate", "ID_Anagrafica=" & Me!id_anagrafica)

strNum_scheda = DLookup("Num_scheda", "Qry_Riepilogo_generale_Schede_liquidate", "ID_Anagrafica=" & Me!id_anagrafica)

strAnno_Liquidazione = DLookup("Anno_liquidazione", "Qry_Riepilogo_generale_Schede_liquidate ", "ID_Anagrafica=" & Me!id_anagrafica)

strDet_liquidazione = DLookup("Det_liquidazione", "Qry_Riepilogo_generale_Schede_liquidate ", "ID_Anagrafica=" & Me!id_anagrafica)

strImporto_lordo = DLookup("Importo_lordo", "Qry_Riepilogo_generale_Schede_liquidate ", "ID_Anagrafica=" & Me!id_anagrafica)

strTot_Ritenute = DLookup("Tot_ritenute", "Qry_Riepilogo_generale_Schede_liquidate ", "ID_Anagrafica=" & Me!id_anagrafica)

strImporto_netto = DLookup("Importo_netto", "Qry_Riepilogo_generale_Schede_liquidate ", "ID_Anagrafica=" & Me!id_anagrafica)

Oggetto = "COMUNICAZIONE"

strMsg = "<!DOCTYPE html PUBBLIC '-//W3C//DTD XTML 1.0 Transitional//EN' 'http://www.w3.org/TR/xhtml1-Transitional.dtd'>"

strMsg = strMsg & "<html xmlns='http://www.w3.org/TR/REC-html40'>"

strMsg = strMsg & "<body>"

strMsg = strMsg & "<p> Gent.ma/o strCognomeNome </p>"

strMsg = strMsg & "<p>con la presente sono ad informarti, in via ufficiosa, che a breve nella sezione</p>"

strMsg = strMsg & "<p>documenti personali del Portale dei Dipendenti, troverà una scheda riepilogativa delle somme </p>"

strMsg = strMsg & "<p>a te liquidate qui brevemente riassunti</p>"

strMsg = strMsg & "<p>nella tabella sottostante:</p>"

strMsg = strMsg & "<table width ='800px' border = '1' cellpadding='0'>"

strMsg = strMsg & "<tr>"

strMsg = strMsg & "<td> <p align='center'><strong>Num. Scheda </strong></p></td>"

strMsg = strMsg & "<td> <p align='center'><strong>Anno liquidazione </strong></p></td>"

strMsg = strMsg & "<td> <p align='center'><strong>Determina liquidazione </strong></p></td>"

strMsg = strMsg & "<td> <p align='center'><strong>Importo lordo </strong></p></td>"

strMsg = strMsg & "<td> <p align='center'><strong>Importo ritenute</strong></p></td>"

strMsg = strMsg & "<td> <p align='center'><strong>Importo netto</strong></p></td>"

strMsg = strMsg & "</tr>"

strMsg = strMsg & "<tr>"

strMsg = strMsg & "<td><p align='center'>" & strNum_scheda & "</p></td>"

strMsg = strMsg & "<td><p align='center'>" & strAnno_Liquidazione & "</p></td>"

strMsg = strMsg & "<td><p align='center'>" & strDet_liquidazione & "</p></td>"

strMsg = strMsg & "<td><p align='center'>" & Format(strImporto_lordo, "Standard") & "</p></td>"

strMsg = strMsg & "<td><p align='center'>" & Format(strTot_Ritenute, "Standard") & "</p></td>"

strMsg = strMsg & "<td><p align='center'>" & Format(strImporto_netto, "Standard") & "</p></td>"

strMsg = strMsg & "</table>"

strMsg = strMsg & "<p> Distinti saluti </p>"

strMsg = strMsg & "<p> p. Il Direttore</p>"

strMsg = strMsg & "</tr>"

strMsg = strMsg & "</body>"

strMsg = strMsg & "</html>"

If VBA.MsgBox(prompt:="Vuoi spedire una email di avvenuta liquidazione incentivi?", _

               Buttons:=vbYesNo, _

               title:="Informazione") = vbYes Then

With OutMail

    .To = strDest

    .Cc = strDirettore

    .Bcc = ""

    .Subject = "COMUNICAZIONE."

    .htmlBody = strMsg

    .Display

    '.send

End With

Set OutMail = Nothing

Set OutApp = Nothing

End If

End Sub

L'email viene creata (riportando solo il primo record della query) con il giusto destinario ed Il risultato che ottengo è il seguente:

Gent.ma/o

con la presente sono ad informarti, in via ufficiosa, che a breve nella sezione

documenti personali del Portale dei Dipendenti, troverà una scheda riepilogativa delle somme

a te liquidate, qui brevemente riassunti nella tabella sottostante:

Num. Scheda Anno liquidazione Determina liquidazione Importo lordo Importo ritenute Importo netto
ED-MS_006 2023 837 - 19/05/2023 143,14 36,71 106,43

Distinti saluti

Chiedo il vostro aiuto per creare la tabella di cui all'esempio in premessa (prima del codice vba) tenuto conto che per ogni id_anagrafica ci possono essere uno o più righe da compilare tante per quante schede dove l'id è presente

Grazie a tutti coloro che vogliono aiutarmi.

Buona serata

Luca

Microsoft 365 e Office | Access | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti
Risposta accettata dall'autore della domanda
domenico laurenza 9,900 Punti di reputazione Moderatore volontario
2023-07-21T16:02:12+00:00

DoCmd.SetWarnings False

Togli il segno di uguale .

E' dal 1998 che lo scrivo ma non mi entra in testa che a differenza degli altri non vuole l'uguale !!!

La risposta è stata utile?

1 persona ha trovato utile questa risposta.
0 commenti
Risposta accettata dall'autore della domanda
domenico laurenza 9,900 Punti di reputazione Moderatore volontario
2023-07-21T09:01:10+00:00

In attesa di un tuo riscontro, ho individuato un primo errore/dimenticanza, dovresti cambiare l'istruzione

Set wRst = CurrentDb.OpenRecordset("Select \* From Qry\_Riepilogo\_generale\_Schede\_liquidate")

con

Set wRst = CurrentDb.OpenRecordset("Select \* From Qry\_Riepilogo\_generale\_Schede\_liquidate **Where Id\_Anagrafica = " & id\_anagrafica**)

che ti permette di trattare un solo Id_Anagrafica come tu facevi nelle singole DLookUp del tuo codice origine

Mimmo

La risposta è stata utile?

1 persona ha trovato utile questa risposta.
0 commenti
Risposta accettata dall'autore della domanda
domenico laurenza 9,900 Punti di reputazione Moderatore volontario
2023-07-20T15:04:09+00:00

Ciao Luca,

ho tentato di rivedere il tuo codice utilizzando una tabella invece della tua query da cui ricavare i dati.

Inoltre ho scritto il codice in una funzione a cui passo i valori Id_Anagrafica e id_servizio ( se pensi di utilizzarlo visto che nel tuo codice è commentato).

Non sono in grado di testare il tutto, provaci tu.

Questo il codice:

Option Compare Database

Option Explicit

Function fGenera_eMail(id_anagrafica, id_servizio)

    Dim OutApp As Object

    Dim OutMail As Object

    Dim wRst As Recordset

    Dim strMsg As String

    Dim strDest As String

    Dim strDirettore As String

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)  'crea nuova email

    Set wRst = CurrentDb.OpenRecordset("Select * From Qry_Riepilogo_generale_Schede_liquidate")

    If wRst.EOF Then

       GoTo Chiudi

    End If

    wRst.MoveFirst

    strDest = DLookup("email", "Anagrafica", "ID_Anagrafica=" & id_anagrafica)

    'strDirettore = DLookup("email_rup", "Servizio", "ID_servizio=" & Me!id_servizio)

    strMsg = "<!DOCTYPE html PUBBLIC '-//W3C//DTD XTML 1.0 Transitional//EN' 'http://www.w3.org/TR/xhtml1-Transitional.dtd'>"

    strMsg = strMsg & "<html xmlns='http://www.w3.org/TR/REC-html40'>"

    strMsg = strMsg & "<body>"

    strMsg = strMsg & "<p> Gent.ma/o strCognomeNome </p>"

    strMsg = strMsg & "<p>con la presente sono ad informarti, in via ufficiosa, che a breve nella sezione</p>"

    strMsg = strMsg & "<p>documenti personali del Portale dei Dipendenti, troverà una scheda riepilogativa delle somme </p>"

    strMsg = strMsg & "<p>a te liquidate  qui brevemente riassunti</p>"

    strMsg = strMsg & "<p>nella tabella sottostante:</p>"

    strMsg = strMsg & "<table width ='800px' border = '1' cellpadding='0'>"

    strMsg = strMsg & "<tr>"

    strMsg = strMsg & "<td> <p align='center'><strong>Num. Scheda </strong></p></td>"

    strMsg = strMsg & "<td> <p align='center'><strong>Anno liquidazione </strong></p></td>"

    strMsg = strMsg & "<td> <p align='center'><strong>Determina liquidazione </strong></p></td>"

    strMsg = strMsg & "<td> <p align='center'><strong>Importo lordo </strong></p></td>"

    strMsg = strMsg & "<td> <p align='center'><strong>Importo ritenute</strong></p></td>"

    strMsg = strMsg & "<td> <p align='center'><strong>Importo netto</strong></p></td>"

    strMsg = strMsg & "</tr>"

    Do While Not wRst.EOF

       strMsg = strMsg & "<tr>"

       strMsg = strMsg & "<td><p align='center'>" & wRst("Num_scheda") & "</p></td>"

       strMsg = strMsg & "<td><p align='center'>" & wRst("Anno_Liquidazione") & "</p></td>"

       strMsg = strMsg & "<td><p align='center'>" & wRst("Det_liquidazione") & "</p></td>"

       strMsg = strMsg & "<td><p align='center'>" & Format(wRst("Importo_lordo"), "Standard") & "</p></td>"

       strMsg = strMsg & "<td><p align='center'>" & Format(wRst("Tot_Ritenute"), "Standard") & "</p></td>"

       strMsg = strMsg & "<td><p align='center'>" & Format(wRst("Importo_netto"), "Standard") & "</p></td>"

       wRst.MoveNext

    Loop

    strMsg = strMsg & "</table>"

    strMsg = strMsg & "<p> Distinti saluti </p>"

    strMsg = strMsg & "<p> p. Il Direttore</p>"

    strMsg = strMsg & "</tr>"

    strMsg = strMsg & "</body>"

    strMsg = strMsg & "</html>"

    If VBA.MsgBox(prompt:="Vuoi spedire una email di avvenuta liquidazione incentivi?", _

               Buttons:=vbYesNo, _

               title:="Informazione") = vbYes Then

       With OutMail

         .To = strDest

         .Cc = strDirettore

         .Bcc = ""

         .Subject = "COMUNICAZIONE."

         .htmlBody = strMsg

         .Display

        '.send

       End With

       Set OutMail = Nothing

       Set OutApp = Nothing

    End If

Chiudi:

    Set wRst = Nothing

End Function

Facci sapere

Ciao Mimmo

La risposta è stata utile?

1 persona ha trovato utile questa risposta.
0 commenti

10 risposte aggiuntive

Ordina per: Più utili
Più utili Più recente Meno recente
  1. domenico laurenza 9,900 Punti di reputazione Moderatore volontario
    2023-07-21T13:13:58+00:00

    Ciao Luca,

    dopo la conferma all'invio della Mail e l'effettivo invio, possiamo aggiornare il campo invio_email_quota della tabella Quota_incentivi

    dando per scontato che nella tabella Quota_incentivi tu abbia il campo Num_scheda che identifichi il record come nella tabella generata nella Mail

    possiamo impostare qualcosa di simile ( non l'ho testato ) evidenziato in grassetto:

    If VBA.MsgBox(prompt:="Vuoi spedire una email di avvenuta liquidazione incentivi?", \_

                   Buttons:=vbYesNo, _

                   title:="Informazione") = vbYes Then

           With OutMail

             .To = strDest

             .Cc = strDirettore

             .Bcc = ""

             .Subject = "COMUNICAZIONE."

             .htmlBody = strMsg

             .Display

            '.send

           End With

       **wRst.MoveFirst**

   **DoCmd.SetWarning = False**

**Do While Not wRst.EOF**

         **DoCmd.RunSql ("Update Quota\_incentivi Set invio\_email\_quota = -1 Where Num\_scheda = '" & wRst("Num\_scheda") & "'")**

       **wRst.MoveNext**

    Loop

       **DoCmd.SetWarning = True**

   Set OutMail = Nothing

           Set OutApp = Nothing

        End If

    Facci sapere

    Mimmo

    La risposta è stata utile?

    0 commenti
  2. Anonimo
    2023-07-21T10:47:32+00:00

    Ciao Mimmo

    per il codice da te elaborato ti ho risposto proprio poco tempo fa ... ed ho contrassegnato "risolto".

    Per completare correttamente il processo, avrei la necessità, anche al fine di non inviare gli stessi dati in una successiva email, per cui per ogni riga riportata nella query, ho inserito un controllo (campo denominato invio_email_quota della tabella Quota_incentivi) che mi permetterebbe di contrassegnare come true tale campo al momento della generazione dell'email.

    Immagino, come ho letto in alcune pagine che illustra la funzione Do While che ci sia bisogno di un ulteriore ciclo Do While sulla base di un secondo Rs basato sulla tabella Quota_incentivi, che mi trasformi il campo invio_email_quota da false a true con un update della tabella.

    Non è che potresti aiutarmi anche in questo secondo cliclo Do While implementando il codice già scritto da tee funzionante ?

    Luca

    La risposta è stata utile?

    0 commenti