VBA per invio email, con destinatari e oggetto variabile, in base a condizione

Question

Buongiorno a tutti,

sto muovendo i primi passi con il linguaggio VBA e mi si presenta un "problema" che vorrei (risolvendolo, ovviamente) sfruttare per spronarmi ad entrare più nel dettaglio del codice.

L'obbiettivo sarebbe il seguente: sulla base della scadenza di un certificato (evento che viene calcolato e genera in colonna O l'output "SCADUTO"), vorrei fare in modo che sia possibile inviare una mail via Outlook tramite click su pulsante agli indirizzi (al plurale, non c'è mai un indirizzo email unico) dei fornitori, usando un testo fisso come corpo, ma variando l'oggetto (che sarà da comporre con il nome delle materie prime con certificato scaduto). In CC sarà presente sempre un solo indirizzo email.

La struttura del foglio, ad oggi, è composta di diverse righe per ciascun fornitore, ognuna relativa ad una materia prima.

La difficoltà maggiore credo sia il creare una sola email che raggruppi tutte le materie prime "scadute" di un singolo fornitore.

Se qualche anima pia avesse voglia di propormi un codice funzionale alla risoluzione di questo task, magari spiegandomi sommariamente la funzione dei vari blocchi di codice.

Grazie in anticipo, ovviamente sono a disposizione per qualsiasi delucidazione.

Answer 1

Ciao Cavegiorgi,

Hai ragione, mi spiego meglio: abbiamo più righe per ciascun fornitore, corrispondenti ognuna ad una diversa materia prima; la necessità è che venga generata una email singola per ciascun fornitore, ma che riporti in oggetto tutte le materie prime con certificato scaduto.

Nel mio esempio, dovremmo quindi generare:

• una mail per il fornitore ACB relativa alla materia prima A001;
• una mail per il fornitore BGL relativa alle materie prime B042 e B050;

Prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

 '========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim WB As Workbook 

Dim srcSH As Worksheet, tmpSH As Worksheet, fornitoreSH As Worksheet 

Dim oTabella As ListObject, oTabella2 As ListObject 

Dim Rng As Range, RngDati As Range, rRow As Range, RngCodici As Range 

Dim arrDati As Variant 

Dim arrFornitori() As Variant 

Dim arrIdirizzi() As Variant 

Dim sFornitore As String, sDestinatarie As String, sAttachment As String, sBody As String, sOggetto As String 

Dim i As Long, j As Long 

Const sFoglio As String = **"Foglio1"                                                                        '<<=== Modifica** 

Const sTabella As String = **"Tabella1"** 

Const sObject As String = "**Richiesta certificato aggiornato**  "                              **'<<=== Modifica** 

sBody = "**Buongiorno," \_** 

    **& vbNewLine \_** 

    **& "La presente per chiedervi gentilmente i certificati aggiornati per le materie prime in oggetto" \_** 

    **& "Un cordiale saluto," \_** 

    **& vbNewLine & vbNewLine \_** 

    **& "Team ABCD**"                                                                                                 **'<<=== Modifica** 

Set WB = ThisWorkbook 

With WB 

    Set srcSH = .Sheets(sFoglio) 

    Set tmpSH = .Sheets.Add 

    tmpSH.Name = "Dati\_Scaduti" 

End With 

Set oTabella = srcSH.ListObjects(sTabella) 

oTabella.Range.AutoFilter Field:=5, Criteria1:="SCADUTO" 

On Error Resume Next 

Set Rng = oTabella.Range.SpecialCells(xlCellTypeVisible) 

On Error GoTo 0 

If Not Rng Is Nothing Then 

    On Error GoTo XIT 

    With Application 

        .DisplayAlerts = False 

        .ScreenUpdating = False 

    End With 

    Rng.Copy Destination:=tmpSH.Range("A1") 

    Set RngDati = tmpSH.Range("A1").CurrentRegion 

    RngDati.EntireColumn.AutoFit 

    tmpSH.ListObjects.Add(xlSrcRange, RngDati, , xlYes).Name = \_ 

        "TempTable" 

    Set oTabella2 = tmpSH.ListObjects(1) 

    arrFornitori = SortedUniqueList(oTabella2.DataBodyRange.Columns(1).Value) 

    For i = 1 To UBound(arrFornitori) 

        sFornitore = arrFornitori(i) 

        oTabella2.Range.AutoFilter Field:=1, Criteria1:=sFornitore 

        sDestinatarie = Replace(oTabella2.DataBodyRange.Cells(1, 2).Value, " ", "") 

        Set fornitoreSH = WB.Sheets.Add 

        oTabella2.Range.SpecialCells(xlCellTypeVisible).Copy Destination:=fornitoreSH.Range("A1") 

        With ActiveSheet 

            .Name = "Report" 

            Set RngCodici = Intersect(ActiveSheet.UsedRange.Offset(1).Resize(.UsedRange.Rows.Count - 1), .Columns("C")) 

            sOggetto = sObject & Join(Application.Transpose(RngCodici.Value), "-") 

            With .UsedRange 

                .Value = .Value 

                .EntireColumn.AutoFit 

            End With 

            .Copy 

            .Delete 

        End With 

        With ActiveWorkbook 

            sAttachment = sFornitore & Format(Date, "dd-mm-yyyy") 

            .SaveAs Filename:=sFornitore & Format(Date, "dd-mm-yyyy"), FileFormat:=51 

            sAttachment = .FullName 

            .Close 

        End With 

        Call Invia\_Mail(sAttachment, sDestinatarie, sOggetto, sBody) 

        On Error GoTo XIT 

    Next i 

    tmpSH.Delete 

Else 

    Call MsgBox(Prompt:="Nessun dato trovato per la settimana corrispondente!", \_ 

        Buttons:=vbCritical, \_ 

        Title:="REPORT") 

End If 

XIT:

With Application 

    .DisplayAlerts = True 

    .ScreenUpdating = True 

End With 

oTabella.AutoFilter.ShowAllData 

End Sub

'-------->>

Public Function SortedUniqueList(V As Variant)

Dim oSortedUniqueList As Object 

Dim arrOut() As Variant 

Dim sStr As String 

Dim i As Long 

Set oSortedUniqueList = CreateObject("System.Collections.Sortedlist") 

With oSortedUniqueList 

    For i = LBound(V) To UBound(V) 

        sStr = V(i, 1) 

                    If Not sStr = vbNullString Then 

                        If Not .ContainsKey(sStr) Then 

        .Add Key:=sStr, Value:=i 

                        End If 

                    End If 

    Next i 

    ReDim arrOut(1 To .Count) 

    For i = 0 To .Count - 1 

        arrOut(i + 1) = .GetKey(i) 

    Next i 

End With 

SortedUniqueList = arrOut 

End Function

'-------->>

Public Sub Invia_Mail(sFullName As String, sRecipient As String, sSubject As String, sBody As String)

Dim oOutlook As Object 

Dim oMail As Object 

With Application 

    .EnableEvents = False 

    .ScreenUpdating = False 

End With 

Set oOutlook = CreateObject("Outlook.Application") 

Set oMail = oOutlook.CreateItem(0) 

On Error Resume Next 

With oMail 

    .To = sRecipient 

    .CC = "" 

    .BCC = "" 

    .Subject = sSubject 

    .Body = sBody 

    .Attachments.Add sFullName 

    .Display 'Send 

End With 

On Error GoTo 0 

With Application 

    .EnableEvents = True 

    .ScreenUpdating = True 

End With 

Set oMail = Nothing 

Set oOutlook = Nothing 

End Sub

'<<========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel.
• Salva il file con l'estensione xlsm
• Alt+F8 per aprire la finestra di gestione delle macro
• Seleziona Tester
• Esegui

Esegendo questo codice con i dati del tuo file, ottengo i seguenti due email:

.

Nota Bene:

Prima di eseguire il codice, ho converito i tuoi dati in una tabella Excel strutturata

Potresti scaricare il mio file di prova Cavegiorgi20231010.xlsm

===

Regards,

Norman

Answer 2

Hai ragione, mi spiego meglio: abbiamo più righe per ciascun fornitore, corrispondenti ognuna ad una diversa materia prima; la necessità è che venga generata una email singola per ciascun fornitore, ma che riporti in oggetto tutte le materie prime con certificato scaduto.

Nel mio esempio, dovremmo quindi generare:

• una mail per il fornitore ACB relativa alla materia prima A001;
• una mail per il fornitore BGL relativa alle materie prime B042 e B050;

Spero di essere stato più chiaro.

Grazie ancora

Answer 3

Ciao Cavegiorgi,

Ho scaricato il tuo file:

.

Purtroppo, però, io non riesco a capire come si possa creare l'oggetto email

                                        **Richiesta certificato aggiornato A001-A010** 

dai dati di esempio.

In attesa di un tuo chiarimento, forse mi sarei aspettato un risultato del seguente genere:

                                       **Richiesta certificato aggiornato A001-B042-BO50**

===

Regards,

Norman

Answer 4

Ciao Cavegiorgi,

sto muovendo i primi passi con il linguaggio VBA e mi si presenta un "problema" che vorrei (risolvendolo, ovviamente) sfruttare per spronarmi ad entrare più nel dettaglio del codice.

L'obbiettivo sarebbe il seguente: sulla base della scadenza di un certificato (evento che viene calcolato e genera in colonna O l'output "SCADUTO"), vorrei fare in modo che sia possibile inviare una mail via Outlook tramite click su pulsante agli indirizzi (al plurale, non c'è mai un indirizzo email unico) dei fornitori, usando un testo fisso come corpo, ma variando l'oggetto (che sarà da comporre con il nome delle materie prime con certificato scaduto). In CC sarà presente sempre un solo indirizzo email.

La struttura del foglio, ad oggi, è composta di diverse righe per ciascun fornitore, ognuna relativa ad una materia prima.

La difficoltà maggiore credo sia il creare una sola email che raggruppi tutte le materie prime "scadute" di un singolo fornitore.

Se qualche anima pia avesse voglia di propormi un codice funzionale alla risoluzione di questo task, magari spiegandomi sommariamente la funzione dei vari blocchi di codice.

Per evitare supposizioni, ti chiedo gentilmente di caricare un semplice file di esempio, privo di dati sensibili e, utilizzando questi dati, fornire un esempio di email richiesta, inclusi indirizzi e oggetto email. Per motivi di chiarezza ti chiedo inoltre di evidenziare l'indirizzo email richiesto e i dati dell'oggetto.

===

Regards,

Norman

Buongiorno Norman,

grazie dell'interesse, allego link alla cartella e uno screen di una email tipo.

L'oggetto della email dovrà essere composto da una frase fissa e dai codici materie prime con certificati in scadenza, possibilmente separati da uno spazio o da un simbolo come in esempio.

esempio_email.xlsx

Answer 5

Ciao Cavegiorgi,

sto muovendo i primi passi con il linguaggio VBA e mi si presenta un "problema" che vorrei (risolvendolo, ovviamente) sfruttare per spronarmi ad entrare più nel dettaglio del codice.

L'obbiettivo sarebbe il seguente: sulla base della scadenza di un certificato (evento che viene calcolato e genera in colonna O l'output "SCADUTO"), vorrei fare in modo che sia possibile inviare una mail via Outlook tramite click su pulsante agli indirizzi (al plurale, non c'è mai un indirizzo email unico) dei fornitori, usando un testo fisso come corpo, ma variando l'oggetto (che sarà da comporre con il nome delle materie prime con certificato scaduto). In CC sarà presente sempre un solo indirizzo email.

La struttura del foglio, ad oggi, è composta di diverse righe per ciascun fornitore, ognuna relativa ad una materia prima.

La difficoltà maggiore credo sia il creare una sola email che raggruppi tutte le materie prime "scadute" di un singolo fornitore.

Se qualche anima pia avesse voglia di propormi un codice funzionale alla risoluzione di questo task, magari spiegandomi sommariamente la funzione dei vari blocchi di codice.

Per evitare supposizioni, ti chiedo gentilmente di caricare un semplice file di esempio, privo di dati sensibili e, utilizzando questi dati, fornire un esempio di email richiesta, inclusi indirizzi e oggetto email. Per motivi di chiarezza ti chiedo inoltre di evidenziare l'indirizzo email richiesto e i dati dell'oggetto.

===

Regards,

Norman