Creazione Invio Email e Formattazione testo

[FROST220684Partecipante FROST220684]

Guarda ho provato adesso questo codice ed ho inserito la libreria che trovi in allegato e provando il codice mi da l'errore che vedi in allegato non so perchè ma a me sembra che l'oggetto sia specificato.

Sub CDO_Mail_Small_Text()
Dim CDO_Mail As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strbody As String

strSubject = "Report da foglio Excel"
strFrom = "email mittente"
strTo = "email mittente"
strCc = ""
strBcc = ""
strbody = "Il risultato per questo trimestre è"
Set CDO_Mail = CreateObject("CDO.Message")
On Error GoTo Error_Handling

Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1

Set SMTP_Config = CDO_Config.Fields

With SMTP_Config
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method.
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.aruba.it"
 .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 465
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "email mittente"
 .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
 .Update
End With

With CDO_Mail
 Set .Configuration = CDO_Config
End With
CDO_Mail.Subject = strSubject
CDO_Mail.From = strFrom
CDO_Mail.To = strTo
CDO_Mail.TextBody = strbody
CDO_Mail.CC = strCc
CDO_Mail.BCC = strBcc
CDO_Mail.Send

Error_Handling:
If Err.Description <> "" Then MsgBox Err.Description

End Sub

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Allora, ho abbandonato il CDO, girando in internet ho trovato il codice che ho inserito al file che ti posto, ho provato spedendomi delle email che ho ricevuto regolarmente, il codice spedisce una email sfruttando il tuo account predefinito, a prescindere del tuo programma per inviare le email. Ti allego  il file, lancia la macro "compleanno" che trovi sul "modulo2",naturalmente prima devi inserire gli indirizzi reali nelle celle del foglio di excel.

fai sapere

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


'Procedura di preparazione messaggio mailto
Sub SendMailWithMailTo(to_email_address As String, cc_email_address As String, bcc_email_address As String, subject As String, body As String)

    If to_email_address = "" Then

        MsgBox "Impossibile inviare email. " & vbCrLf & "Non è presente l'indirizzo email di destinazione del messaggio." & vbCrLf & _
               "(Sub = SendMailWithMailTo) " & vbCrLf & "(" & Now() & ")", vbCritical

    Else

        Dim v_mailto As String
        v_mailto = "mailto:" & to_email_address

        'Se esiste almeno un parametro valorizzato aggiungo il carattere ?
        If cc_email_address <> "" Or bcc_email_address <> "" Or subject <> "" Or body <> "" Then
            v_mailto = v_mailto & "?"
        End If

        If cc_email_address <> "" Then
            v_mailto = v_mailto & "cc=" & cc_email_address & "&"
        End If

        If bcc_email_address <> "" Then
            v_mailto = v_mailto & "bcc=" & bcc_email_address & "&"
        End If

        If subject <> "" Then
            v_mailto = v_mailto & "subject=" & subject & "&"
        End If

        If body <> "" Then
            v_mailto = v_mailto & "body=" & body & "&"
        End If

        'Se esiste almeno un parametro valorizzato aggiungo tolgo l'ultimo carattere &
        If cc_email_address <> "" Or bcc_email_address <> "" Or subject <> "" Or body <> "" Then

            'MsgBox Len(v_mailto)
            v_mailto = Mid(v_mailto, 1, Len(v_mailto) - 1)

        End If

        Dim result As Long
        result = ShellExecute(0&, "open", v_mailto, "", "", 1)
        Application.Wait (Now + TimeValue("0:00:01"))
        SendKeys "^{ENTER}", True
    End If

End Sub

Sub compleanno()
    Dim lastrow As Integer
    Dim dataoggi As Date
    Dim tabelladata As Range, con As Object
    Dim anni As Integer
    lastrow = Cells(Rows.Count, 3).End(xlUp).Row
    Set tabelladata = Range("c2:c" & lastrow)
    dataoggi = Now()
    For Each con In tabelladata
        If (Day(con) = Day(dataoggi)) And (Month(con) = Month(dataoggi)) Then
            anni = Year(dataoggi) - Year(con)
            con.Select
            Email = ActiveCell.Offset(0, -1)
            MsgBox "buon compleanno oggi hai compiuto anni   " & anni
       SendMailWithMailTo ActiveCell.Offset(0, -1), "", " ", "Oggetto mail", "Auguri di buon compleanno %0D%0A Questa è la seconda linea"
        End If
    Next
End Sub

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

Caro Albatros,

Innanzitutto ti ringrazio per il tempo speso per me. Non lo considero sicuramente una cosa dovuta e di questo te ne sono grato. 

Il codice mi risulta essere abbastanza corretto ti dico cosa fa il codice per step:

1. Se inserisco una data corretta tipo 04/03/1950 - mi esce un popup che mi da gli auguri dicendomi che ho compiuto 70 anni (cosa che non servirebbe) (a me interessa che invii la email a quel mittente e basta)

2. si apre il programma App Posta di Windows 10 e crea in automatico un messaggio di augurio con gli indirizzi corretti che però salva in bozze e non invia direttamente non so perchè. Insomma invece di inviare il messaggio lo salva in bozze ed anche se io poi premo invio non so perchè non succede nulla. allego immagini per farti capire.

3. non so perchè io quando scarico i file che mi allegano mi dice sempre file danneggiato. potresti mandarlo tramite email? ti mando un messaggio privato se vuoi.

Saluti

e 1000 grazie

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

FROST220684 ha scritto:

mi

Allora ho eliminato questa stringa MsgBox "buon compleanno oggi hai compiuto anni " & anni in modo che non compari più il popup quindi questo è ok.

rimane il problema che le email invece di essere inviate rimangono in bozze e poi avrei necessità di allegare un file sempre uguale preso dal desktop o comunque da un percorso predefinito.

Grazie a tutti per l'aiuto

[albatros54Moderatore albatros54 Karma: 89 pts]

il problema dei quesiti postati sui vari forum è il fatto che non tutti gli utenti hanno le stesse piattaforme, il codice che ti ho postato è stato testato piu volte e nella mia piattaforma fa quello che gli chiediamo(Win 7 pro e excel 2010), aprendo l'account predefinito e invia regolarmente l'email.

FROST220684 ha scritto:

rimane il problema che le email invece di essere inviate rimangono in bozze e poi avrei necessità di allegare un file sempre uguale preso dal desktop o comunque da un percorso predefinito.

questo per il momento, secondo me, puo passare in secondo piano, tu devi riuscire a capire perchè mette la tua email in bozze e non la invia

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[FROST220684Partecipante FROST220684]

Allora Albatros,

Sono riuscito a capirci qualcosa almeno sembra. Allora la mail non inviava in automatico e lasciava in bozze poi ho notato che nel campo cc c'era <> ed eliminando questa stringa la mail la invia in automatico 

Or bcc_email_address <>

If bcc_email_address <> "" Then v_mailto = v_mailto & "bcc=" & bcc_email_address & "&" End If

il problema che ho verificato ora è quando ci sono più date di compleanni. Su 3 Compleanni 1 email la invia mentre le altre 2 rimangono in bozze 🙂

Insomma il procedimento è giusto c'è qualcosa che sfugge tu che dici?

grazie

 

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

FROST220684 ha scritto:

Allora Albatros,

Ti allego anche il file con il codice modificato se inserisci una email nei riquadri bianchi mi potresti dire se a te invia tutte e 3 le email

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

albatros54 ha scritto:

Application.Wait (Now + TimeValue("0:00:01"))

prova ad aumentare il tempo di attesa inserendo modificando cosi

Application.Wait (Now + TimeValue("0:00:03"))

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[albatros54Moderatore albatros54 Karma: 89 pts]

FROST220684 ha scritto:

riquadri bianchi mi potresti dire se a te invia tutte e 3 le email

li invia regolarmente

 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[FROST220684Partecipante FROST220684]

a me rimane in bozze anche modificando il tempo :(((( ma che cavolo sarà sicuramente una stupidata

 

la prima la invia e le altre in bozze. ma tu con cosa invii la posta con quale piattaforma?

 

ho provato ad eliminare l'account posta da windows 10 ed installare thunderbird ma non so perchè quando lancio la macro mi apre sempre posta windows 10 eppure ho messo thunderbird come predefinito 🙂 le sto provando tutte 🙂

[FROST220684Partecipante FROST220684]

Allora 🙂 Che poi nessuno dica che non provo 🙂 Scherzo naturalmente.

Allora Albatros, Sono riuscito ad impostare Thunderbird come applicazione predefinita e le email vengono inviate correttamente 😉

----------------------------------------------------------------------------------------------------------------------------------------------------------

Il discorso invio email è concluso. Avrei ora bisogno di alcuni accorgimenti:

1) Allegare un file a queste email sarebbe tipo un pdf grafico di buon compleanno (é sempre lo stesso e si trova sempre nello stesso posto)

2) mettere una cella di controllo "SI O NO" (tipo una spunta che se c'è la mail la invia se non c'è passa alla successiva o si ferma, quindi giusto per capire il sistema invia la email sono se la data di compleanno è rispettata e se c'è il segno su SI. se c'e' no o la cella è vuota non invia nulla e passa al successivo.

Grazie Mille Albatros devo dire che sei sempre di aiuto e riesco anche a ragionare 🙂

ti allego file di quello che intendo per spunta.

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

FROST220684 ha scritto:

Sono riuscito ad impostare Thunderbird

lo potevi dire mooolto prima  che potevi usare Thunderbird come account, avremmo risolto molto tempo prima.Fammi sistemere un po, che poi ti posto il codice per Thunderbird

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[FROST220684Partecipante FROST220684]

Scusa Albatros,

ma ho cercato solo di sistemare quello che non andava e ci ho pensato dopo. 🙂

 

Cmq ripeto funziona tutto. ho solo necessità di modificare quello che ti dicevo prima. Ad ogni modo aspetto te :**** Grazie

[albatros54Moderatore albatros54 Karma: 89 pts]

ti posto questo codice, devi solo modificare il path dove si trova Thunderbird, studialo e puoi apportare le modifiche che piu ti piacciono, per il momento questo codice ti fa allegare gli allegati, poi vediamo per gli altri step, provalo e fai sapere, ti allego il file

`Sub compleanno()
    Dim lastrow As Integer
    Dim dataoggi As Date
    Dim tabelladata As Range, con As Object
    Dim anni As Integer
    lastrow = Cells(Rows.Count, 3).End(xlUp).Row
    Set tabelladata = Range("c2:c" & lastrow)
    dataoggi = Now()
    For Each con In tabelladata
        If (Day(con) = Day(dataoggi)) And (Month(con) = Month(dataoggi)) Then
            anni = Year(dataoggi) - Year(con)
            con.Select
            Email = ActiveCell.Offset(0, -1)
            Call fSendThunderbird(ActiveCell.Offset(0, -1), "", "", "AUGURI", "C:\Users\Albatros\Desktop\orarioexcel.pdf")
        End If
    Next
End Sub

Sub fSendThunderbird(to_email_address As String, cc_email_address As String, bcc_email_address As String, subject As String, allegato As String)

'http://forums.mozillazine.org/viewtopic.php?t=399230&highlight=&sid=2c05f35f3050c34449d0c0deaf16621a
'http://kb.mozillazine.org/Command_line_arguments_-_Thunderbird

'http://email.about.com/od/mozillathunderbirdtips/qt/Send_an_Image_Inline_Without_Attaching_It_in_Thunderbird.htm

'http://kb.mozillazine.org/Creating_complex_mails_with_inline_images

    Dim strCommand As String    ' Command line to prepare Thunderbird e-mail
    Dim strTo As String    ' E-mail address
    Dim strCC As String    'E-mail address
    Dim strBcc As String    'E-mail address
    Dim strSubject As String    ' Subject line
    Dim strBody As String    ' E-mail body
    Dim strAttachment As String    'Allegati

    Const cFormato As Integer = 1   '1: HTML    2:Plain Text

    strTo = to_email_address
    strCC = cc_email_address
    strBcc = bcc_email_address
    strSubject = subject
    strAttachment = allegato


    strBody = "Linea 1
" _
            & "Linea 2" & "
" _
            & "Linea 3" & "
" _
            & "
" _
            & "Firma" & "
" _
            & "
" _
            & "Immagine 1 (remota)" & "
" _
            & "" _
            & "
" _
            & "Immagine 2 (locale)" & "
" _
            & ""


    strCommand = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"' <<<----DA MODIFICARE

    strCommand = strCommand & " -compose to='" & strTo & "'," _
               & "cc='" & strCC & "'," _
               & "bcc='" & strBcc & "'," _
               & "subject='" & strSubject & "'," _
               & "format='" & cFormato & "'," _
               & "body='" & strBody & "'," _
               & "attachment='" & strAttachment & "'"


    Call Shell(strCommand, vbNormalFocus)
    Application.Wait (Now + TimeValue("0:00:03"))
    SendKeys "^{ENTER}", True
End Sub
`

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

FROST220684 ha scritto:

mettere una cella di controllo "SI O NO" (tipo una spunta che se c'è la mail la invia se non c'è passa alla successiva o si ferma, quindi giusto per capire il sistema invia la email sono se la data di compleanno è rispettata e se c'è il segno su SI

Ho aggiunto due righe di codice alla routine "compleanno", sostituisci il codice con quello che ti posto.

Sub compleanno()
    Dim lastrow As Integer
    Dim dataoggi As Date
    Dim tabelladata As Range, con As Object
    Dim anni As Integer
    lastrow = Cells(Rows.Count, 3).End(xlUp).Row
    Set tabelladata = Range("c2:c" & lastrow)
    dataoggi = Now()
    For Each con In tabelladata
        If (Day(con) = Day(dataoggi)) And (Month(con) = Month(dataoggi)) Then
            anni = Year(dataoggi) - Year(con)
            con.Select
            Email = ActiveCell.Offset(0, -1)
            If UCase(ActiveCell.Offset(0, 3)) = "SI" Then
            Call fSendThunderbird(ActiveCell.Offset(0, -1), "", "", "AUGURI", "C:\Users\Albatros\Desktop\orarioexcel.pdf")
        Else
        End If
        End If
    Next
End Sub

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[FROST220684Partecipante FROST220684]

Funziona perfettamente. L'unico problema non sono riuscito ad allegare file se non in tipo pdf. Nel senso che mi fa allegare solo pdf.

Ad ogni modo funziona perfettamente. Appena hai tempo mi guardi quella cosa che ti ho chiesto su

 mettere una cella di controllo "SI O NO" (tipo una spunta che se c'è la mail la invia se non c'è passa alla successiva o si ferma, quindi giusto per capire il sistema invia la email sono se la data di compleanno è rispettata e se c'è il segno su SI. se c'e' no o la cella è vuota non invia nulla e passa al successivo.

 

grazie

[albatros54Moderatore albatros54 Karma: 89 pts]

scusa ma hai letto il post#23999, fa tutto quello che hai chiesto  

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[FROST220684Partecipante FROST220684]

Si albatros non ho avuto tempo di connettermi ma avevo già controllato sembra perfetto. Appena rientro a lavoro lo riguardo e ti dico. Grazie tante

[FROST220684Partecipante FROST220684]

Caro Albatros,

Tutto perfetto effettua la ricerca ed invia come richiesto chiaramente adesso devo verificare a livello grafico come la voglio inviare quindi poi modifico un po di campi ed in caso ti dico.

Senti avrei bisogno di verificare se alcune cose sono fattibili. Come dicevo ad inizio post in questo file che esporto ci sono delle email che a me non servono e di conseguenza vorrei cancellare mi servirebbe una macro a parte che cancelli dalla colonna B(Email) tutte le righe che al loro interno contengono le seguenti parole @m.expediapartnercentral.com, @guest.booking.com;

Come posso fare?

 

Grazie mille per tutto il supporto.

[FROST220684Partecipante FROST220684]

Sub Cancella Contenuto()
Dim rng As Range
Dim cel As Range
Set rng = Range("A1:F10000")
For Each cel In rng
If InStr(1, cel.Value, "@guest.booking.com") <> 0 Then
cel.ClearContents
End If
If InStr(1, cel.Value, "@m.expediapartnercentral.com") <> 0 Then
cel.ClearContents
End If
Next cel
End Sub

Albatros lascia stare sono riuscito a risolvere grazie mille

[Autore]

Articoli