Ci sei andato vicino...
L'errore bloccante e' stato aver usato
If cell.Value = "Secondo sollecito >30gg" mentre la scritta che hai adottato nel foglio e' "Secondo Sollecito >30gg" (il confronto con "=" e' case-sensitive).
Comunque mi permetto di modificare la macro in
- Codice: Seleziona tutto
Sub InviaEmail()
Dim OutlookApp As Object
Dim MItem As Object
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String '?? A Che serve?
Dim Bonus As String '?? A Che serve?
Dim Msg As String, ToSend As Boolean
Dim miorange As Range '?? A Che serve?
Dim flag As Range '?? A Che serve?
Dim UR As Long, mCnt As Long
'
UR = Sheets("evasi").Range("a" & Rows.Count).End(xlUp).Row
Set miorange = Range("a1:a" & UR) '?? A Che serve?
Set flag = Range("f1:f" & UR) '?? A Che serve?
Set OutlookApp = CreateObject("Outlook.Application")
For Each cell In Range("f2:f" & UR)
If InStr(1, cell.Value, "Primo Sollecito", vbTextCompare) > 0 And _
Range("M" & cell.Row).Value <> "INVIATO PRIMO SOLLECITO PROFILO" And _
InStr(1, Range("E" & cell.Row).Value, "@", vbTextCompare) > 0 Then
Range("M" & cell.Row).Value = "INVIATO PRIMO SOLLECITO PROFILO"
Subj = "Subject del primo Sollecito"
ToSend = True
ElseIf InStr(1, cell.Value, "Secondo Sollecito", vbTextCompare) > 0 And _
Range("N" & cell.Row).Value <> "INVIATO SECONDO SOLLECITO PROFILO" And _
InStr(1, Range("E" & cell.Row).Value, "@", vbTextCompare) > 0 Then
Range("N" & cell.Row).Value = "INVIATO SECONDO SOLLECITO PROFILO"
Subj = "Subject del Secondo sollecito"
ToSend = True
Else
ToSend = False
End If
'
If ToSend Then
mCnt = mCnt + 1
EmailAddr = Range("e" & cell.Row).Value
Msg = "Buongiorno, si sollecita TESTO A PIACERE a proposito di " & Range("b" & cell.Row).Value & " " & Range("c" & cell.Row).Value & " ALTRO TESTO A PIACERE " & Range("d" & cell.Row).Value & " ALTRO TESTO A PIACERE " & vbCrLf & "Grazie e cordiali saluti"
Set MItem = OutlookApp.CreateItem(0)
With MItem
.To = EmailAddr
.Subject = Subj
.Body = Msg
.Display '**1
'.Send '**2
'Application.Wait (Now + TimeValue("0:00:02")) '**2
End With
End If
Next
Set OutlookApp = Nothing
MsgBox ("Completato; inviate N° " & mCnt & " email")
End Sub
Le modifiche riguardano:
-in controllo che in colonna E ci sia presumibilmente un indirizzo mail
-l'accorpamento delle parti comuni in un unico blocco
Cosi' come e', la mail viene visualizzata e non spedita; devi procedere manualmente col comando Invia nella visualizzazione della mail.
Se hai una versione Outlook >2003 allora puoi "commentare la riga **1 (metti un apostrofo all'inizio) e "scommentare" le istruzioni **2 (togliere l'apostrofo iniziale), e in questo modo le mail saranno accodate per l'invio in Outlook, che avverra' secondo le modalita' impostate di Invia/Ricevi.
Se invece hai OL2003 o precedente (specifica quale versione) allora, se proprio ti interessa fare in modo che le mail partano automaticamente, possiamo fare una variante al codice.
Ho inserito la macro nel file che hai pubblicato.
Ciao