invio grafici in body email

Hai un problema con Excel?

Nuova discussione

invio grafici in body email
di nessi (utente non iscritto) data: 20/05/2015 14:00:29
buon giorno, ho un problema che non sto riuscendo a risolvere. da una userform con un pulsante devo inviare via mail i grafici contenuti in un foglio di excel allegandoli in formato foto ed inserendoli nel bodytext della mail stessa. operazione apparentemente semplice ma non ci sto riuscendo.
utilizzo office 2010 professional con win7 a casa e win8 in ufficio.
quella che allego è la routine che ho eleaborato ma sono più le volte che mi va in errore di inserimento immagine che altro. inoltre non allega nulla. niente foto.
possibile avere una mano? mi basterebbe una traccia da elaborare.
grazie per l'aiuto.

Private Sub CommandButton18_Click()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Fname1 As String
    Dim Fname2 As String
    Dim Fname3 As String
    Dim Fname4 As String
    Dim Fname5 As String
    Dim Fname6 As String
    Dim Fname7 As String
    Dim Fname8 As String
    Dim Fname9 As String
    Dim Fname10 As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    Fname1 = Environ$("temp") & "Sost2014.gif"
    Fname2 = Environ$("temp") & "Sost2015.gif"
    Fname3 = Environ$("temp") & "SMS1.gif"
    Fname4 = Environ$("temp") & "SMS2.gif"
    Fname5 = Environ$("temp") & "SMS3.gif"
    Fname6 = Environ$("temp") & "SMS4.gif"
    Fname7 = Environ$("temp") & "SMS5.gif"
    Fname8 = Environ$("temp") & "SMS6.gif"
    Fname9 = Environ$("temp") & "SMS7.gif"
    Fname10 = Environ$("temp") & "SMS8.gif"
 
    ActiveWorkbook.Worksheets("SETUP").ChartObjects("Grafico 1").Chart.Export _
            Filename:=Fname1, FilterName:="GIF"
    
    ActiveWorkbook.Worksheets("SETUP").ChartObjects("Grafico 3").Chart.Export _
            Filename:=Fname2, FilterName:="GIF"
    
    ActiveWorkbook.Worksheets("SETUP").ChartObjects("Grafico 4").Chart.Export _
            Filename:=Fname3, FilterName:="GIF"
    
    ActiveWorkbook.Worksheets("SETUP").ChartObjects("Grafico 7").Chart.Export _
            Filename:=Fname4, FilterName:="GIF"
    
    ActiveWorkbook.Worksheets("SETUP").ChartObjects("Grafico 8").Chart.Export _
            Filename:=Fname5, FilterName:="GIF"
    
    ActiveWorkbook.Worksheets("SETUP").ChartObjects("Grafico 9").Chart.Export _
            Filename:=Fname6, FilterName:="GIF"
    
    ActiveWorkbook.Worksheets("SETUP").ChartObjects("Grafico 10").Chart.Export _
            Filename:=Fname7, FilterName:="GIF"
    
    ActiveWorkbook.Worksheets("SETUP").ChartObjects("Grafico 11").Chart.Export _
            Filename:=Fname8, FilterName:="GIF"
    
    ActiveWorkbook.Worksheets("SETUP").ChartObjects("Grafico 12").Chart.Export _
            Filename:=Fname9, FilterName:="GIF"
    
    ActiveWorkbook.Worksheets("SETUP").ChartObjects("Grafico 13").Chart.Export _
            Filename:=Fname10, FilterName:="GIF"

PERCORSOFILEIMMAGINE1 = Environ$("temp") & ""   'SOLO PERCORSO, con  finale
FILEIMMAGINE1 = "Sost2014.gif"

PERCORSOFILEIMMAGINE2 = Environ$("temp") & ""   'SOLO PERCORSO, con  finale
FILEIMMAGINE2 = "Sost2015.gif"

PERCORSOFILEIMMAGINE3 = Environ$("temp") & ""   'SOLO PERCORSO, con  finale
FILEIMMAGINE3 = "SMS1.gif"

PERCORSOFILEIMMAGINE4 = Environ$("temp") & ""   'SOLO PERCORSO, con  finale
FILEIMMAGINE4 = "SMS2.gif"

PERCORSOFILEIMMAGINE5 = Environ$("temp") & ""   'SOLO PERCORSO, con  finale
FILEIMMAGINE5 = "SMS3.gif"

PERCORSOFILEIMMAGINE6 = Environ$("temp") & ""   'SOLO PERCORSO, con  finale
FILEIMMAGINE6 = "SMS4.gif"

PERCORSOFILEIMMAGINE7 = Environ$("temp") & ""   'SOLO PERCORSO, con  finale
FILEIMMAGINE7 = "SMS5.gif"

PERCORSOFILEIMMAGINE8 = Environ$("temp") & ""   'SOLO PERCORSO, con  finale
FILEIMMAGINE8 = "SMS6.gif"

PERCORSOFILEIMMAGINE9 = Environ$("temp") & ""   'SOLO PERCORSO, con  finale
FILEIMMAGINE9 = "SMS7.gif"

PERCORSOFILEIMMAGINE10 = Environ$("temp") & ""   'SOLO PERCORSO, con  finale
FILEIMMAGINE10 = "SMS8.gif"

Immagine = " " & _
    "Egregio CAT " & CATanagrafica.TextBox2.Value & ", in allegato i grafici statistici di Vostra competenza. " & _
    " " & _
    "Statistica Sostituzioni 2014: " & _
    "
" & _
    "Statistica Sostituzioni 2015: " & _
    "
" & _
    "Abbiamo posto 6 domande ai Clienti alla conclusione della Commessa. Ecco i Risultati: " & _
    "Domanda 1:" & _
    "
" & _
    "Domanda 2: " & _
    "
" & _
    "Domanda 3: " & _
    "
" & _
    "Domanda 4:" & _
    "
" & _
    "Domanda 5:" & _
    "
" & _
    "Domanda 6: " & _
    "
" & _
    "Domanda 7: " & _
    "
" & _
    "Domanda 8:" & _
    "
" & _
    "Saluti"

    On Error Resume Next
    With OutMail
        .To = CATanagrafica.TextBox9.Value
        .CC = ""
        .BCC = ""
        .Subject = "Invio Statistica " & CATanagrafica.TextBox2.Value
        .HTMLBody = Immagine
        .Attachments.Add Fname1
        .Attachments.Add Fname2
        .Attachments.Add Fname3
        .Attachments.Add Fname4
        .Attachments.Add Fname5
        .Attachments.Add Fname6
        .Attachments.Add Fname7
        .Attachments.Add Fname8
        .Attachments.Add Fname9
        .Attachments.Add Fname10
        .display 
    End With
    On Error GoTo 0

    Kill Fname1
    Kill Fname2
    Kill Fname3
    Kill Fname4
    Kill Fname5
    Kill Fname6
    Kill Fname7
    Kill Fname8
    Kill Fname9
    Kill Fname10

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

di scossa data: 21/05/2015 09:29:39
Questa "riduzione" del codice funziona senza problemi, quindi vedi di adattarla ed espanderla correttamente per il tuo contesto.

N.B.: nel testo html da assegnare alla variabile Testo, sostituisci il carattere { con < ed il carattere } con > .

scossa's web site

Se tu hai una mela, ed io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno.
Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

Private Sub test()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Fname1 As String
    Dim Testo As String
    Dim FILEIMMAGINE1 As String

    Fname1 = "G:DocsExcelNewsGroupExcelVbaIt
essigrafico.gif" 'Environ$("temp") & "Sost2014.gif"
    FILEIMMAGINE1 = "grafico.gif"
    ActiveWorkbook.Worksheets("SETUP").ChartObjects("Grafico 1").Chart.Export _
            Filename:=Fname1, FilterName:="GIF"



Testo = "{html}{head}{/head}{body} " & _
    "{p}Egregio CAT, in allegato i grafici statistici di Vostra competenza. {/p}" & _
    "{p} {/p}" & _
    "{p}Statistica Sostituzioni 2014: {/p}" & _
    "{img src='" & FILEIMMAGINE1 & "'/}{/b}{br}" & _
    "{p}Saluti{/body}{/html}"

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = "pippo.baudo@pluto.it"
        .CC = ""
        .BCC = ""
        .Subject = "prova "
        .HTMLBody = Testo
        .Attachments.Add Fname1
        .display
    End With

    Kill Fname1

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

di lepat (utente non iscritto) data: 21/05/2015 09:59:04
Ottimo scossa, non avresti una versione per chi come me usa soltanto gmail dal browser ?

di scossa data: 21/05/2015 18:47:08
cit. lepat: " non avresti una versione per chi come me usa soltanto gmail dal browser ?"

trovi tutto qui:
how-to-send-an-email-using-excel-macro-from-gmail-or-yahoo

scossa's web site

di nessi (utente non iscritto) data: 21/05/2015 21:20:12
Grazie Scossa. Grazie mille. ora lo adatto così verifico.
se non ho capito male dove ho mancato:
in pratica non posso usare lo stesso filename.gif sia per l'attach che l'htlmbody e/o comunque non posso inserirlo nel body da temp. giusto?
di nessi (utente non iscritto) data: 21/05/2015 22:17:39
rieccomi. ci ho lavorato un po'.
per funzionare funziona, grazie mille. però non mi crea il gif allegato.
in realtà avrei bisogno dell'immagine del grafico sia nel body che in allegato. credi si possa riuscire?

di scossa data: 23/05/2015 13:52:24
cit. nessi: "in realtà avrei bisogno dell'immagine del grafico sia nel body che in allegato. credi si possa riuscire?"

Ti ripropongo il codice di esempio corretto e migliorato, vedi di adattarlo correttamente.
Ovviamente, nel codice reale puoi usare direttamente i tag html anziché le {}.

Questo codice (che funziona in quanto l'ho testato) inserisce l'immagine nel corpo della mail e anche come allegato.

scossa's web site

Private Sub test()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Fname1 As String
    Dim Testo As String
    
    Fname1 = "X:NewsGroupExcelVbaIt
essigrafico.gif" 'Environ$("temp") & "Sost2014.gif"

    ActiveWorkbook.Worksheets("SETUP").ChartObjects("Grafico 1").Chart.Export _
            Filename:=Fname1, FilterName:="GIF"



    Testo = "{html}{head}{/head}{body} " & _
      "{p}Egregio CAT, in allegato i grafici statistici di Vostra competenza. {/p}" & _
      "{p} {/p}" & _
      "{p}Statistica Sostituzioni 2014: {/p}" & _
      "{img src='" & Fname1 & "'/}{br}" & _
      "{p}Saluti{/body}{/html}"

    Testo = Replace(Replace(Testo, "{", "<"), "}", ">")

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = "pippo.baudo@pluto.it"
        .CC = ""
        .BCC = ""
        .Subject = "prova "
        .HTMLBody = Testo
        .Attachments.Add Fname1
        .display
    End With

    Kill Fname1

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

di nessi (utente non iscritto) data: 06/06/2015 11:20:22
grazie Scossa!
scusate tutti se non ho risposto prima ma ho avuto grossi problemi con la posta.
in linea generale andava bene anche prima se non che, servendomi l'archiviazione per altri scopi, ho cercato di nominare i file immagine in modo univoco ed in una cartella apposita. "Photo".
la routine funziona benissimo se non che sono più le volte che genera nell'archivio un file nominato giusto ma ... vuoto.
a volte corretto a volte (il più delle volte in vero) vuoto.
grazie per l'attenzione che mi presterete!

Sub InviaGraficiGif()
Dim OutApp As Object
    Dim OutMail As Object
    Dim Fname1 As String
    Dim Testo As String
    Dim PDF As String
        
Fname1 = Environ("USERPROFILE") & "DesktopSERVIZIOPhoto" & Range("D2").Value & "_" & Format(Now, "dd-mm-yy") & "_" & "TMFP.gif"
PDF = Environ("USERPROFILE") & "DesktopSERVIZIOPhotoStatistica" & "_" & Range("E2").Value & "_" & Format(Now, "dd-mmm-yyyy") & ".pdf"
Testo = " " & _
     "Egregio CAT " & Range("F2").Value & ", in allegato i grafici statistici di Vostra competenza. " & _
    " " & _
    "Numero Commesse per Marchio: " & _
    "
" & _
    "RicordandoVi che la presente comunicazione ha come unico scopo il fine statistico, ci è gradita l'occasione per porgere," & _
    "Distinti Saluti" & _
    "Lo Staff"

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Invio Statistica " & Range("F2").Value
        .HTMLBody = Testo
        .Attachments.Add Fname1
        .Attachments.Add PDF
        .display
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Sub SalvaGrafico1()
NomePathFile = Environ("USERPROFILE") & "DesktopSERVIZIOPhoto" & Range("D2").Value & "_" & Format(Now, "dd-mm-yy") & "_" & "TMFP.gif"
ActiveWorkbook.Worksheets("REPORT").ChartObjects("Grafico 1").Chart.Export Filename:=NomePathFile, Filtername:="GIF"
End Sub

Sub GeneraPdf()
'Application.ScreenUpdating = False
    Worksheets("REPORT").Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Environ("USERPROFILE") & "DesktopSERVIZIOPhotoStatistica" & "_" & Range("E2").Value & "_" & Format(Now, "dd-mmm-yyyy") & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True _
        , IgnorePrintAreas:=False, OpenAfterPublish:=False
        Worksheets("REPORT").Select
'Application.ScreenUpdating = True
End Sub

Vuoi Approfondire?