[Excel] - Invio email

[il_perozzi]

Ciao a tutti,
volevo un consiglio su come poter inviare una mail automaticamente qualora una cella contenga un determinato risultato, chiarisco

ho una tabella compilata da "A" a "N" in cui la casella "A" contiene la validità, vorrei poter inviare l'intera riga (quindi da cella "A" a cella "N") ad un indirizzo email (presente in cella "P1") quando la cella "A" abbia il valore "scaduta".

il_perozzi

[alfrimpa]

Ciao il_perozzi

Il valore "scaduta" in colonna A lo inserisci tu o deriva da una formula?

[il_perozzi]

Deriva da una formula (se la data di scadenza è minore di oggi è scaduta, altrimenti è valida)

il_perozzi

[alfrimpa]

La macro si può fare tranquillamente ma tieni presente che quando, con il passare del tempo, una posizione da "valida" diventerà "scaduta" la macro non parte in automatico ma deve essere lanciata in altra maniera.

Magari se alleghi un file di esempio......

P.S. Sotto la tua discussione ce ne è una esattamente identica.

[il_perozzi]

Allego il file

<a href=http://www.filedropper.com/forum><img src=http://www.filedropper.com/download_button.png width=127 height=145 border=0/></a><br /><div style=font-size:9px;font-family:Arial, Helvetica, sans-serif;width:127px;font-color:#44a854;> <a href=http://www.filedropper.com >online backup storage</a></div>

[il_perozzi]

http://www.filedropper.com/forum_2

scusate, ecco quello giusto

[alfrimpa]

Ciao il_perozzi

La seguente macro

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
  Dim Bonus As String
  Dim Msg As String
  Dim miorange As Range
  Dim ur As Long
  ur = Sheets("Foglio1").Range("a" & Rows.Count).End(xlUp).Row
  Set miorange = Range("a1:a" & ur)
  Set OutlookApp = CreateObject("Outlook.Application")
  For Each cell In miorange
    If cell.Value = "scaduta" Then
      Subj = "SCADENZE"
      EmailAddr = Range("P1").Value
            Msg = Range("a" & cell.Row).Value & " " & Range("b" & cell.Row).Value & " " & Range("c" & cell.Row).Value & " " & Range("d" & cell.Row).Value & " " & Range("e" & cell.Row).Value & " " & Range("f" & cell.Row).Value & " " & Range("g" & cell.Row).Value & " " & Range("h" & cell.Row).Value & " " & Range("i" & cell.Row).Value & " " & Range("j" & cell.Row).Value & " " & Range("k" & cell.Row).Value & " " & Range("l" & cell.Row).Value & " " & Range("m" & cell.Row).Value & " " & Range("n" & cell.Row).Value
      Set MItem = OutlookApp.CreateItem(0)
      With MItem
        .To = EmailAddr
        .Subject = Subj
        .Body = Msg
        .Display
        '.Send
      End With
    End If
  Next
  Set OutlookApp = Nothing
End Sub

Scorre la colonna A e se trova il valore "scaduta" invia una mail all'indirizzo in P1 col l'oggetto "SCADENZE" e con corpo del messaggio il contenuto delle cella dalla colonna A alla colonna N.

N.B. La macro così come è mostra la mail a video; se la vuoi inviare devi togliere l'apostrofo che è davanti a ".Send" e metterlo davanti a ".Display".

Ti ricordo che la macro va lanciata perché non è possibile eseguirla in automatico.

Ti allego il file

http://www.filedropper.com/ilperozzi

[Anthony47]

Nell'ipotesi che sia preferibile avere una unica mail con il riepilogo di tutte le scadenze prova questa variante della macro di Alfredo:

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
  '??Dim Bonus As String
  Dim Msg As String
  Dim mioRange As Range
  Dim Ur As Long, myCnt As Long
Ur = Sheets("Foglio1").Range("a" & Rows.Count).End(xlUp).Row
Set mioRange = Range("a1:a" & Ur)
Set OutlookApp = CreateObject("Outlook.Application")
' 
Subj = "SCADENZE AL " & Format(Now, "dd-mmm-yyyy")
EmailAddr = Range("P1").Value
Msg = ""
'
For Each cell In mioRange
  If cell.Value = "scaduta" Then
          Msg = Msg & Range("a" & cell.Row).Value & " " & Range("b" & cell.Row).Value & " " & Range("c" & cell.Row).Value _
            & " " & Range("d" & cell.Row).Value & " " & Range("e" & cell.Row).Value & " " & Range("f" & cell.Row).Value _
            & " " & Range("g" & cell.Row).Value & " " & Format(Range("h" & cell.Row).Value, "dd-mmm-yyyy") & " " & _
            Format(Range("i" & cell.Row).Value, "dd-mmm-yyyy") & " " & Range("j" & cell.Row).Value & " " & _
            Range("k" & cell.Row).Value & " " & Range("l" & cell.Row).Value & " " & Range("m" & cell.Row).Value & " " & _
            Range("n" & cell.Row).Value
          Msg = Msg & vbCrLf & vbCrLf
          myCnt = myCnt + 1
  End If
Next
Set MItem = OutlookApp.CreateItem(0)
If myCnt = 0 Then Msg = "Nessuna scadenza da segnalare"
With MItem
  .To = EmailAddr
  .Subject = Subj
  .Body = Msg
'  .Display
   .Send
End With
Application.Wait (Now + TimeValue("0:00:04"))
Set OutlookApp = Nothing
End Sub


Questo codice e' idoneo per Outlook 2010 e superiori, non per OL2003 e inferiori (non so come si comporta OL2007).
Si potrebbe semplificare la compilazione di Msg con un ulteriore ciclo di concatenamento delle celle A:N, ma visto che l'istruzione che le concatena tutte e' gia' fatta l'ho lasciata cosi'.

Ciao a tutti.