Moderatori: Anthony47, Flash30005
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
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
Torna a Applicazioni Office Windows
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Excel: problema con date se devo unirle a testi Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 5 |
confrontare e evidenziare 2 fogli excel Autore: niccia |
Forum: Applicazioni Office Windows Risposte: 7 |
Visitano il forum: Nessuno e 10 ospiti