Inviare il risultato di una query con Outlook Stampa
Scritto da Leonardo Bettarelli e Cinzia Pagani   
Lunedì 26 Ottobre 2009 23:03

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