Questa procedura consente di inviare per email il risultato di una query, senza allegati ma costruendo la tabella risultante nel corpo della mail.
La procedura è abbastanza generica e può eventualmente essere personalizzata secondo le proprie necesità, utilizza Outlook e visualizza la mail prima dell'invio, in modo tale che l'utente possa controllarla ed eventualmente aggiungere qualcosa prima di inviarla.
Es. di Utilizzo:
InviaEmail("ICinqueMiglioriClienti", "I 5 migliori clienti del mese", "Ciao, ecco l'elenco dei nostri 5 migliori Clienti: ", "Saluti <br/> Reparto Sales", " Questo indirizzo e-mail è protetto dallo spam bot. Abilita Javascript per vederlo. ", "", "")
Public Sub InviaEmail(query As String, Oggetto As String, IntestazioneMessaggio As String, _
Piede As String, a As String, cc As String, ccn As String)
'query = Nome della query da eseguire o istruzione SQL
'Oggetto = oggetto della Mail
'IntestazioneMessaggio = Intestazione html del messaggio
'Piede= stringa HTML di chiusura del messaggio
'a = destinatario della mail
'cc = Copiaconoscenza
'ccn = copia conoscenza nascosta
Dim OutApp As Object
Dim OutMail As Object
Dim corpo2 As String
Dim rst As DAO.Recordset
Dim fld As Field
'-------- 1 APRO UN RECORSET SULLA Query passata --------------------------------
Set rst = CurrentDb.OpenRecordset(query)
If rst.RecordCount > 0 Then
rst.MoveFirst
'-------- 2 CREO IL CORPO DELL'EMAIL IN HTML ------------------------------------
corpo2 = IntestazioneMessaggio & "<br/>"
' ciclo tutti i campi presenti nella query per costruire l'intestazione Tabella
corpo2 = corpo2 & vbCrLf & "<table border=1 bgcolor=#FFFFFF width=80% height=30 " & _
"cellspacing=0 style=border-collapse: collapse bordercolor=#111111 cellpadding=5> <tr>"
For Each fld In rst.Fields
corpo2 = corpo2 & "<th align=center><strong>" & fld.Name & "</strong></th>"
Next
corpo2 = corpo2 & "</tr>" & vbCrLf
Do While Not rst.EOF
corpo2 = corpo2 & "<tr>"
For Each fld In rst.Fields
If fld.Type = dbLong Or fld.Type = dbInteger Or fld.Type = dbNumeric Then
corpo2 = corpo2 & "<td align=right> " & fld.Value & "</td>" & vbCrLf
Else
corpo2 = corpo2 & "<td align=left> " & fld.Value & "</td>" & vbCrLf
End If
Next
corpo2 = corpo2 & "</tr>" & vbCrLf
rst.MoveNext
Loop
rst.Close
corpo2 = corpo2 & "</table>" & vbCrLf
'Aggiungo il piede del messaggio
corpo2 = corpo2 & Piede
' ------ 3 CREO L’EMAIL ---------------------------------------------------------
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
' indirizzo a cui spedire
OutMail.to = a
' indirizzo a cui spedire in cc
OutMail.cc = cc
OutMail.BCC = ccn
' oggetto dell'email
OutMail.Subject = Oggetto
' associo al Body dell'email il corpo in html precedentemente creato
OutMail.HTMLBody = corpo2
' visualizzo l'email appena creata
OutMail.Display
' per inviare senza visualizzare utilizzzare OutMail.Send
' nel caso abbiate necessità di inviare anche un allegato
'OutMail.Attachments.Add (percorso file), 1, 1, "allegato"
'----------------------------------------------------------------------------
Set OutMail = Nothing
Set rst = Nothing
Set OutApp = Nothing
Else
MsgBox ("Non ci sono dati da inviare")
End If
End Sub