Moderatori: Anthony47, Flash30005
Sub Invioemail22()
Dim OutApp As Object, I As Long
Dim OutMail As Object, OutFile As String
Dim EmailAddr As String
Dim Subj As String
Dim BDT As String
' (a)
Set OutApp = CreateObject("Outlook.Application")
For I = 271 To 10000 'In realta' usciremo prima di arrivare a 10k...
If Cells(I, "F").Value = "" Then Exit For
If InStr(1, Cells(I, "D").Value, "@", vbTextCompare) > 0 Then 'Indirizzo presente
'compilazione di un testo standard di accompagnamento
BDT = "Caro/a " & Cells(I, "G").Value & ", " & vbCrLf '<<<"
BDT = BDT & Sheets("QualeFoglio").Range("CellaConMessaggio") '<<<
BDT = BDT & vbCrLf & "Cordiali saluti" & vbCrLf '<<<
BDT = BDT & "Il tuo negozio" '<<<
'' (b)
OutFile = "C:\pippo\peppo.pdf" '<<< L' eventuale allegato
EmailAddr = Cells(I, "D").Value 'Indirizzo email
Subj = "Offerta speciale per te" '<<< Oggetto della mail
'
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = EmailAddr
.CC = ""
.BCC = ""
.Subject = Subj
.Attachments.Add OutFile '<<< Allega l' allegato
.Body = BDT
' .Display 'or use .send
.send
End With
Application.Wait (Now + TimeValue("0:00:02"))
' (c)
Set OutMail = Nothing
'
End If
Next I
' (d)
Set OutApp = Nothing
'
End Sub
Sub SMSAmico()
MsgBox " Avvia Outlook per l'invio dell'SMS"
Dim myOutlook As Object
Dim myMailItem As Object
variabileEmailDelDestinatario = [E29] 'E29 N°telefono per l'SMS
If variabileEmailDelDestinatario = "" Then Exit Sub
'Dim TestoEmail As String
BDT = BDT & vbCrLf & "Caro/a " & [E22] & " , " & [E23] & vbCrLf 'compilazione di un testo standard di accompagnamento
BDT = BDT & vbCrLf & " " & vbCrLf
BDT = BDT & vbCrLf & "Grazie per averci Consigliati al sig. " & " , " & [E9] & ", " & [E10] & vbCrLf 'legge nella riga E9-E10
BDT = BDT & vbCrLf & " " & vbCrLf
BDT = BDT & vbCrLf & " Siamo lieti di accreditarle 2 Punti fedeltà sulla sua scheda " & vbCrLf '<<<<< Testo
BDT = BDT & vbCrLf & " " & vbCrLf
BDT = BDT & vbCrLf & " Ti Aspettiamo " & vbCrLf '<<<<< Testo
BDT = BDT & vbCrLf & "Cordiali saluti" & vbCrLf '<<<
BDT = BDT & vbCrLf & " " & vbCrLf
BDT = BDT & "Tuo Fai da TE" '<<<<< Testo
If [E29] = "@" Then Exit Sub ' verifica disponibilità Numero Telefono
MsgBox "Invio SMS al/alla Sig. " & [E22] & ", " & [E23] 'Messaggio Nome del cliente che ha presentato
Set otlApp = CreateObject("Outlook.Application")
Set otlNewMail = otlApp.CreateItem(olMailItem)
With otlNewMail
.To = variabileEmailDelDestinatario
.Subject = [D20] '"OGGETTO DEL MESSAGGIO"
.Body = BDT 'TestoEmail
.Display
.Send
End With
End Sub
EmailAddr = Range("E29").Value & "@invia.subitosms.it"
.Subject = "TuoUserName TuaPassword"
non so cosa dire; pero' mi sembra strano che se non c' e' un numero di telefono nella cella qualcuno ci metta la "@"If [E29] = "@" Then Exit Sub ' verifica disponibilità Numero Telefono
If Range("E29") = "" Or Not IsNumeric(Range("E29").Value) Then Exit Sub
Sub EmaiLritirapremio()
MsgBox " Avvia la messaggistica Outlook per l'inviodella mail"
Dim OutApp As Object, i As Long
Dim OutMail As Object, OutFile As String
Dim EmailAddr As String
Dim Subj As String
Dim BDT As String
' (a)
Set OutApp = CreateObject("Outlook.Application")
For i = 14 To 100 'In realta' usciremo prima di arrivare a 10k...
If Cells(i, "AQ").Value = "" Then Exit For
If InStr(1, Cells(i, "AP").Value, "@", vbTextCompare) > 0 Then 'Indirizzo presente in cella AP
BDT = "Caro " & Cells(i, "AM").Value & (", ") & Cells(i, "AN") & (", ") & ("Siamo lieti comunicarti che hai raggiunto ") & (", ") & Cells(i, "AO") & (" Punti ") & (", ") & ("raggiungendo cosi il premio N° ") & Cells(i, "AR") & (", pari ad €uro ") & Cells(i, "AS") 'compilazione di un testo standard di accompagnamento
'BDT = BDT & vbCrLf & " " & vbCrLf
BDT = BDT & Sheets("Hompage").Range("AU25") '<<<
BDT = BDT & vbCrLf & " " & vbCrLf
BDT = BDT & vbCrLf & " Ti Aspettiamo " & vbCrLf
BDT = BDT & vbCrLf & "Cordiali saluti" & vbCrLf '<<<
'BDT = BDT & vbCrLf & " " & vbCrLf
'BDT = BDT & vbCrLf & " " & vbCrLf
BDT = BDT & " Il Tuo Fai da TE" '<<<
' (b)
'OutFile = "C:\Users\Administrator\Desktop " '<<< L' eventuale allegato
EmailAddr = Cells(i, "AP").Value 'Indirizzo email
Subj = Range("AN8").Value '<<< Oggetto della mail cella AN8
'
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = EmailAddr
.CC = " "
'.BCC = ""
.Subject = Subj
'.Attachments.Add OutFile '<<< Allega l' allegato
.Body = BDT
'.Display 'or use .send
.Send
End With
Application.Wait (Now + TimeValue("0:00:04"))
Application.SendKeys "%a"
'Application.Wait (Now + TimeValue("0:00:04"))
' (c)
Set OutMail = Nothing
'
End If
Next i
' (d)
Set OutApp = Nothing
'
MsgBox " Invio mail Terminato "
End Sub
BDT = " " & Cells(i, "AM").Value & (", ") & Cells(i, "AN")
If InStr(1, Cells(i, "AP").Value, "@", vbTextCompare) > 0 And (Now - Cells(i, "AT").Value)>5 Then
Eh, questo e' un forum dove si danno delle dritte piu' o meno vaghe e piu' o meno corrette, non soluzioni chiavi in mano personalizzate
Sub EmaiLritirapremio()
MsgBox " Avvia la messaggistica Outlook per l'inviodella mail"
Dim OutApp As Object, i As Long
Dim OutMail As Object, OutFile As String
Dim EmailAddr As String
Dim Subj As String
Dim BDT As String
' (a)
Set OutApp = CreateObject("Outlook.Application")
For i = 14 To 100
If Cells(i, "AP").Value = "" Then Exit For
If Cells(i, "AM").Value = Cells(i, "AT") Then Exit For
Cells(i, "AT") = Cells(i, "AM").Value & ("- ") & Cells(i, "AN")
Cells(i, "AU") = Date
If InStr(1, Cells(i, "AP").Value, "@", vbTextCompare) > 0 Then 'And (Now - Cells(i, "AU").Value) > ("AL12") Then 'Indirizzo presente in cella D
BDT = "Caro/a " & Cells(i, "AM").Value & (", ") & Cells(i, "AN") & (", ") & ("Siamo lieti comunicarti che hai raggiunto ") & (", ") & Cells(i, "AO") & (" Punti ") & (", ") & ("raggiungendo cosi il premio N° ") & Cells(i, "AR") & (", pari ad €uro ") & Cells(i, "AS") 'compilazione di un testo standard di accompagnamento
BDT = BDT & Sheets("Hompage").Range("az4") '<<<
BDT = BDT & vbCrLf & " " & vbCrLf
BDT = BDT & vbCrLf & " Ti Aspettiamo " & vbCrLf
BDT = BDT & vbCrLf & "Cordiali saluti" & vbCrLf '<<<
BDT = BDT & "BI ESSE legnami Il Tuo Fai da TE"
' (b)
'OutFile = "C:\Users\Administrator\Desktop " '<<< L' eventuale allegato
EmailAddr = Cells(i, "AP").Value 'Indirizzo email
'
Subj = Range("AN8").Value 'Oggetto:nella cella AN8 '"Offerta speciale per te" '<<< Oggetto della mail
'
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = EmailAddr
.CC = ""
'.BCC = ""
.Subject = Subj
'.Attachments.Add OutFile '<<< Allega l' allegato
.Body = BDT
'.Display 'or use .send
.Send
End With
Application.Wait (Now + TimeValue("0:00:08"))
Application.SendKeys "%a"
' (c)
Set OutMail = Nothing
'
End If
Next i
' (d)
Set OutApp = Nothing
'
MsgBox " Fine invio mail"
'End If
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 58 ospiti