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

Anonimo

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 & " Gent.ma/o strCognomeNome "

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

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

strMsg = strMsg & "a te liquidate qui brevemente riassunti"

strMsg = strMsg & "nella tabella sottostante:"

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

strMsg = strMsg & "<tr>"

strMsg = strMsg & "<td> Num. Scheda </td>"

strMsg = strMsg & "<td> Anno liquidazione </td>"

strMsg = strMsg & "<td> Determina liquidazione </td>"

strMsg = strMsg & "<td> Importo lordo </td>"

strMsg = strMsg & "<td> Importo ritenute</td>"

strMsg = strMsg & "<td> Importo netto</td>"

strMsg = strMsg & "</tr>"

strMsg = strMsg & "<tr>"

strMsg = strMsg & "<td>" & strNum_scheda & "</td>"

strMsg = strMsg & "<td>" & strAnno_Liquidazione & "</td>"

strMsg = strMsg & "<td>" & strDet_liquidazione & "</td>"

strMsg = strMsg & "<td>" & Format(strImporto_lordo, "Standard") & "</td>"

strMsg = strMsg & "<td>" & Format(strTot_Ritenute, "Standard") & "</td>"

strMsg = strMsg & "<td>" & Format(strImporto_netto, "Standard") & "</td>"

strMsg = strMsg & "</table>"

strMsg = strMsg & " Distinti saluti "

strMsg = strMsg & " p. Il Direttore"

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

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 Moderatore volontario

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 !!!

0 commenti

Risposta accettata dall'autore della domanda

domenico laurenza 9,900 Moderatore volontario

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

0 commenti

Risposta accettata dall'autore della domanda

domenico laurenza 9,900 Moderatore volontario

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 & " Gent.ma/o strCognomeNome "

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

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

strMsg = strMsg & "a te liquidate qui brevemente riassunti"

strMsg = strMsg & "nella tabella sottostante:"

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

strMsg = strMsg & "<tr>"

strMsg = strMsg & "<td> Num. Scheda </td>"

strMsg = strMsg & "<td> Anno liquidazione </td>"

strMsg = strMsg & "<td> Determina liquidazione </td>"

strMsg = strMsg & "<td> Importo lordo </td>"

strMsg = strMsg & "<td> Importo ritenute</td>"

strMsg = strMsg & "<td> Importo netto</td>"

strMsg = strMsg & "</tr>"

Do While Not wRst.EOF

strMsg = strMsg & "<tr>"

strMsg = strMsg & "<td>" & wRst("Num_scheda") & "</td>"

strMsg = strMsg & "<td>" & wRst("Anno_Liquidazione") & "</td>"

strMsg = strMsg & "<td>" & wRst("Det_liquidazione") & "</td>"

strMsg = strMsg & "<td>" & Format(wRst("Importo_lordo"), "Standard") & "</td>"

strMsg = strMsg & "<td>" & Format(wRst("Tot_Ritenute"), "Standard") & "</td>"

strMsg = strMsg & "<td>" & Format(wRst("Importo_netto"), "Standard") & "</td>"

wRst.MoveNext

Loop

strMsg = strMsg & "</table>"

strMsg = strMsg & " Distinti saluti "

strMsg = strMsg & " p. Il Direttore"

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

0 commenti

10 risposte aggiuntive

Anonimo

2023-07-21T16:32:09+00:00
Ciao Mimmo

ti confermi che la mia intuizione è corretta ed il codice così modificato

wRst.MoveFirst
```
   DoCmd.SetWarnings False 

   Do While Not wRst.EOF 

         **DoCmd.RunSQL ("Update Quota\_incentivi Set invio\_email\_quota = -1 Where Anagrafica\_id = " & wRst("id\_anagrafica"))** 

         wRst.MoveNext 

   Loop 

   DoCmd.SetWarnings True
```
mi restituisce il risultato desiderato.

Grazie della collaborazione, senza il tuo aiuto non ce l'avrei fatta.

Luca
La risposta è stata utile?

1 persona ha trovato utile questa risposta.

0 commenti Nessun commento
Anonimo

2023-07-20T17:43:45+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 & " Gent.ma/o strCognomeNome "

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

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

 strMsg = strMsg & "a te liquidate qui brevemente riassunti"

 strMsg = strMsg & "nella tabella sottostante:"

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

 strMsg = strMsg & "<tr>"

 strMsg = strMsg & "<td> Num. Scheda </td>"

 strMsg = strMsg & "<td> Anno liquidazione </td>"

 strMsg = strMsg & "<td> Determina liquidazione </td>"

 strMsg = strMsg & "<td> Importo lordo </td>"

 strMsg = strMsg & "<td> Importo ritenute</td>"

 strMsg = strMsg & "<td> Importo netto</td>"

 strMsg = strMsg & "</tr>"



 Do While Not wRst.EOF

 strMsg = strMsg & "<tr>"

 strMsg = strMsg & "<td>" & wRst("Num_scheda") & "</td>"

 strMsg = strMsg & "<td>" & wRst("Anno_Liquidazione") & "</td>"

 strMsg = strMsg & "<td>" & wRst("Det_liquidazione") & "</td>"

 strMsg = strMsg & "<td>" & Format(wRst("Importo_lordo"), "Standard") & "</td>"

 strMsg = strMsg & "<td>" & Format(wRst("Tot_Ritenute"), "Standard") & "</td>"

 strMsg = strMsg & "<td>" & Format(wRst("Importo_netto"), "Standard") & "</td>"

 wRst.MoveNext

 Loop



 strMsg = strMsg & "</table>"

 strMsg = strMsg & " Distinti saluti "

 strMsg = strMsg & " p. Il Direttore"

 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

Ciao Mimmo

grazie per la risposta e, soprattutto per il codice elaborato per me.

Non ho specificato nel mio post che il codice io l'ho impostato sull'evento click di un pulsante nella Form anagrafica, ma il codice che mi hai postato è una funzione....

Come posso collegare all'evento click la funzione di composizione dell'email?

Ho anche provato il codice dopo "Private Sub Email_Click()"...ma naturalmente mi rsistuisce un errore.

Grazie

Luca
La risposta è stata utile?

0 commenti Nessun commento