Premesso che credo poco nell'utilita'di mail automatiche, che possono sfociare nello spamming o in imbarazzanti errori; meglio sarebbe che le mail partissero verso i buyer responsabili dei fornitori ritardatari e ci pensassero loro a inoltrarle, se veramente e' utile.
Cio' detto...
Supponiamo che in Foglio3 hai una tabella con in colonna A il nome del fornitore e in colonna B l'indirizzo email corrispondente.
Per cominciare, in un foglio che chiamerai MESS, da A1 in avanti scriverai un messaggio standard di acccompagnamento, anche su piu' righe, compreso la firma. Il resto del foglio lascialo vuoto, sara' usato per riepilogare le righe del DB che appartengono a quel fornitore, corrispondente alle righe che si ottengono facendo doppioclick sulla riga del fornitore.
Puoi occupare quante righe vuoi.
Supponiamo che la tabella pivot abbia esattamente la struttura del file che hai pubblicato e si trovi nel foglio "Tot Forn.Imp.GG", e che l'intestazione di colonna F cominci sempre con "Media gg ritardo".
Tutto cio' premesso, penso che questo codice ti puo' aiutare a ottenere quanto chiedi:
- Codice: Seleziona tutto
Dim OutlookApp As Object 'RIGOROSAMENTE IN TESTA AL MODULO
Sub solleciti()
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=108130
Dim lastF As Long, HF As Boolean, I As Long, Soglia As Long, msSh As Worksheet
Dim mAreaLR As Long, mAreaLC As Long, msNext As Long, pubArea As String, shEmail As Worksheet
Dim myMatch, toEmail As String, pvtSh As Worksheet, mCnt As Long
'
Set pvtSh = Sheets("Tot Forn.Imp.GG") '<<< Il foglio con la pivot table
Set msSh = Sheets("MESS") '<<< Il foglio col messaggio di accompagnamento
Set shEmail = Sheets("Foglio2") '<<< Il foglio con la mappa Fornitore /Email
Soglia = -7 '<<< La soglia reale, NUMERO NEGATIVO
'
lastF = pvtSh.Cells(Rows.Count, "F").End(xlUp).Row
Set OutlookApp = CreateObject("Outlook.Application")
For I = 1 To lastF
pvtSh.Select
If HF Then
If IsNumeric(Cells(I, "F").Value) Then
If Cells(I, "F").Value < Soglia Then
myMatch = Application.Match(Cells(I, "B").Value, shEmail.Range("A:A"), 0)
Cells(I, "F").ShowDetail = True
If Not IsError(myMatch) Then 'Controlla presenza email
' Cells(I, "F").ShowDetail = True
toEmail = shEmail.Cells(myMatch, "B").Value
msNext = msSh.Cells(Rows.Count, "A").End(xlUp).Row
Range("A1").CurrentRegion.Copy _
msSh.Cells(msNext + 3, 1)
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
mAreaLR = msSh.Cells(Rows.Count, "A").End(xlUp).Row
mAreaLC = msSh.Cells(msNext + 3, Columns.Count).End(xlToLeft).Column
pubArea = msSh.Range(msSh.Range("A1"), msSh.Cells(mAreaLR, mAreaLC)).Address
mymess = Replace(RangePublish(msSh.Name, pubArea), "align=center", "align=left", , , vbTextCompare)
Call SendMess(mymess, toEmail)
msSh.Range(msSh.Cells(msNext, "A"), msSh.Cells(mAreaLR, mAreaLC)).Clear
mCnt = mCnt + 1
End If
End If
End If
Else
If UCase(Left(Cells(I, "F"), 16)) = UCase("Media gg ritardo") Then HF = True
End If
Next I
Set OutlookApp = Nothing
MsgBox ("Solleciti Spediti, tot. " & mCnt)
End Sub
Sub SendMess(ByVal myM As String, myD As String)
Dim MItem As Object
Dim Subj As String
'
Subj = "Solleciti al " & Format(Now, "dd-mmm-yyyy")
Set MItem = OutlookApp.CreateItem(0)
With MItem
.To = myD
.cc = "Indirizzo1@dominio1" '<<<< INDIRIZZO IN COPIA
.Subject = Subj
.htmlBody = myM
' .display
.Send
End With
Application.Wait (Now + TimeValue("0:00:02"))
Set MItem = Nothing
End Sub
Function RangePublish(ByVal mySh As String, ByVal PRan As String) As Variant
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=101351
'
Dim TmpFile As String, myBDT As String, PubFile
TmpFile = Environ("Temp") & "\myBDT.htm" 'Lavora in Temp
'Crea file html:
With ThisWorkbook.PublishObjects.Add(SourceType:=xlSourceRange, _
Filename:=TmpFile, _
Sheet:=mySh, _
Source:=PRan, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'
Set FSO = CreateObject("Scripting.FilesystemObject")
Set PubFile = FSO.OpenTextFile(TmpFile, 1, False)
RangePublish = PubFile.ReadAll
PubFile.Close
'
End Function
Inserisci tutto in un Modulo standard del vba; per questo, partendo da Excel:
-premi Alt-F11 per aprire l'editor delle macro
-Menu /Inserisci /Modulo
-Copia il codice e incollalo nel frame dx del modulo appena creato
Personalizza le righe marcate <<< come da commenti.
Poi torna su Excel e all'occorrenza lancia la Sub solleciti:
-premi Alt-F8
-seleziona SOLLECITI dall'elenco di macro disponibili
-premi Esegui
Nel caso di Fornitori di cui non viene trovata la mail nel foglio Fornitore /Email, il foglio dei "dettagli" rimane aperto per le azioni del caso.
Non so se Outlook2007 al momento dell'invio procedera' in modo silente (come fa OL2010) o se segnalera' un tentativo di invio, con invito all'operatore di confermare o smentire (come faceva OL2003); quindi magari dovremo affinare qualcosa.
Prova e fai sapere.