Inserimento testo, immagine e firma con immagine in e-mail

[EnricoBanco]

Ciao,
ho copiato male io, ma sono proprio rinco...Grazie mille ;o)
Provo!!!

Rettifica: la macro excel "Testo_per_email_macro_excel()" l'ho trovata scartabellando in rete.

[EnricoBanco]

Dopo altri giorni di estenuanti prove…Funziona!!! Fantastico!!! Colpa mia per un copia-incolla fasullo. Chiedo perdono!!! Inoltre con le indicazioni di Anthony funziona anche la GetBoiler perché nel codice che usavo, preso dalla rete, mancava il “.Display” dopo il With OutMail e mi sembra questo, dalle prove fatte, la discriminante per inserire la firma (con grafica) usando la GetBoiler.

Grazie mille Anthony!!! :-)

Segue codice processo invio massivo e-mail (o anche una sola). Ho unito più macro trovate in rete e di Anthony prese dal post “Rispondi all’e-mail”. Testato con Outlook 10, Excel 10 e Windows 7.
Quindi partiamo da un file excel in cui in Foglio1 inseriamo in riga 1 nelle colonne da A a H i seguenti campi:
Nr. E-mail oppure un campo data invio e-mail da usarecome memo
E-mail destinatario
Copia per Conoscenza
Copia per conoscenza nascosta
Oggetto della e-mail
Testo della e-mail
Percorso dove si trova il file da allegare (inserire / alla fine)
Nome del file da allegare (nome ed estensione corretti in scheda proprietà del file)
Se si lascia una riga vuota in mezzo crea e-mail vuota da completare.
In Foglio1 ci sono i pulsanti relativi alle macro, in Foglio2 altro testo che si può inserire nell’e-mail per esempio da A1 a T21. Il contenuto parte dalla seconda riga, il “Testo della e-mail” è nella cella F2 (ho usato anche l'opzione testo semplice) da cambiare nel codice al posto di ("A1:T21") e Foglio1 al posto di Foglio2 nella Range Publish al rigo .HTMLbody. Due serie di pulsanti: uno invia testo in F2 e l’altra il testo in Foglio2.
Il file Testo.htm viene creato dalle due Function RangePublish e GetBoiler. Registrata una macro in Word per creare file htm, è solo un ulteriore tool. Le macro da 1 a 4 usano la RangePublish. La macro 7 usa la GetBoiler.
La macro Word ha il vantaggio che allinea il testo nel file testo.htm a sinistra mentre la RangePublishl pone al centro quindi dopo un pò di prove con il codice di Anthony preso nel post in cui si parlava di allineare il contenuto della RangePublish nell'e-mail, questo:

Codice: Seleziona tutto

.HTMLBody = "<table align=left>" & RangePublish("Foglio2", "A1:T21") & .HTMLBody

davanti RangePublish allinea il testo nell'e-mail.
Per lanciare le macro 3) e 7) aprire Outlook.
La firma elaborata in Outlook viene inserita nell'e-mail correttamente e anche con elemento grafico dopo il testo.

Osservazione: non si riesce a inserire nel testo e-mail creato con RangePublish o GetBoiler un elemento grafico che viene correttamente riportato nel file testo.htm ma non nel testo dell’e-mail, neanche se si allega il relativo file.
La soluzione che mi sembra appropriata è allegare in modo tradizionale (.Attachments.Add) il file contenente la grafica desiderata.

Elenco Macro
1) Inviare direttamente le e-mail create dall'elenco con testo in Foglio2
2) creare le e-mail dall'elenco e le visualizza con testo in Foglio2
3) creare le e-mail dall'elenco e le salva in un folder di appoggio (Foder: Processate) con testo in Foglio2
4) inviare e-mail salvate in un folder di appoggio con testo in Foglio2
5) Apre file Word che contiene una macro Word (Macro 6) che crea file htm
6) Macro Word) che crea file htm
7) Crea le e-mail dall'elenco e le salva in un folder di appoggio con testo da Word

Grazie di tutto!!!

Macro 1 - Inviare direttamente le e-mail create dall'elenco con testo in Foglio2

Codice: Seleziona tutto

Sub invia_direttamente()
‘Invia direttamente le e-mail create dall'elenco con testo in Foglio2
 Dim OutApp As Object, OutMail As Object
Dim EmailAddr As String, Subj As String
Dim K As Long
 
DA QUI SI CREA E INVIA LA MAIL:
Set OutApp = CreateObject("Outlook.Application")
Foglio1.Select

' RR contiene il numero di utenti cui inviare le e-mail (1 per utente)
    RR = Range("B" & Rows.Count).End(xlUp).Row
     
' I dati iniziano dalla seconda riga
    For I = 2 To RR
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
             
        With OutMail
        .Display
' La colonna "B" contiene gli indirizzi e-mail dei vari destinatari
               .To = Cells(I, 2)
               
' La colonna "C" contiene l'indirizzo e-mail in "Copia per Conoscenza"
               .CC = Cells(I, 3)
               
' La colonna "D" contiene l'eventuale e-mail in "Copia per conoscenza nascosta"
               .BCC = Cells(I, 4)   'Togliere l'apice davanti al punto se si vuole inserire un indirizzo
               
' La colonna "E" contiene l'oggetto della e-mail
               .Subject = Cells(I, 5)
               
' La colonna "F" contiene l testo della e-mail oppure un range di celle nel Foglio 2
               .HTMLBody = "<table align=left>" & RangePublish("Foglio2", "A1:T21") & .HTMLBody
               

' La colonna "G" contiene il percorso ove si trova il file da allegare
' La colonna "H" contiene il nome del file da allegare
                On Error Resume Next
               .Attachments.Add (Cells(I, 7) & Cells(I, 8))
     
    '.Display
    .Send
   
      K = K + 1
   
End With
Application.Wait (Now + TimeValue("0:00:01"))
Set OutMail = Nothing
Set OutApp = Nothing
'
        Application.SendKeys "%a"
    Next I
    MsgBox ("Completato; (" & K & " messaggi)")
End Sub

‘RangePublish
Function RangePublish(ByVal mySh As String, ByVal PRan As String) As Variant
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=101351
Dim TmpFile As String, myBDT As String, PubFile
TmpFile = "C:\DIR\" & "Testo.htm"       'Vedi testo
'Crea file html:
With ThisWorkbook.PublishObjects.Add(SourceType:=xlSourceRange, _
    Filename:=TmpFile, _
    Sheet:=mySh, _
    Source:=PRan, _
    HtmlType:=xlHtmlStatic)
    .Publish (True)
End With
'
Set fso = CreateObject("Scripting.FilesystemObject")
Set PubFile = fso.OpenTextFile(TmpFile, 1, False)
  RangePublish = PubFile.ReadAll
PubFile.Close
'
End Function

Macro 2 - creare le e-mail dall'elenco e le visualizza con testo in Foglio2

Codice: Seleziona tutto

Sub Crea_e_visualizza()
Dim OutApp As Object, OutMail As Object
Dim EmailAddr As String, Subj As String
Dim K As Long

'DA QUI SI CREA LA MAIL:
Set OutApp = CreateObject("Outlook.Application")

Foglio1.Select

' RR contiene il numero di utenti cui inviare le e-mail (1 per utente)
    RR = Range("B" & Rows.Count).End(xlUp).Row
     
' I dati iniziano dalla seconda riga
    For I = 2 To RR
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
             
        With OutMail
        .Display
' La colonna "B" contiene gli indirizzi e-mail dei vari destinatari
               .To = Cells(I, 2)
               
' La colonna "C" contiene l'indirizzo e-mail in "Copia per Conoscenza"
               .CC = Cells(I, 3)
               
' La colonna "D" contiene l'eventuale e-mail in "Copia per conoscenza nascosta"
               .BCC = Cells(I, 4)   'Togliere l'apice davanti al punto se si vuole inserire un indirizzo
               
' La colonna "E" contiene l'oggetto della e-mail
               .Subject = Cells(I, 5)
               
' La colonna "F" contiene l testo della e-mail oppure un range di celle nel Foglio1 o nel Foglio 2
               .HTMLBody = "<table align=left>" & RangePublish("Foglio2", "A1:T21") & .HTMLBody

' La colonna "G" contiene il percorso ove si trova il file da allegare
' La colonna "H" contiene il nome del file da allegare
                On Error Resume Next
               .Attachments.Add (Cells(I, 7) & Cells(I, 8))
     
    .Display 'Il .Display funziona correttamente se si mette l'apice a Application.SendKeys "%a"
    '.Send
   
      K = K + 1
   
End With
'  (c)
Application.Wait (Now + TimeValue("0:00:01"))
Set OutMail = Nothing
'  (d)
Set OutApp = Nothing
'
'Application.SendKeys "%a"
Next I
MsgBox ("Completato; (" & K & " messaggi)")
End Sub

‘RangePublish
Function RangePublish(ByVal mySh As String, ByVal PRan As String) As Variant
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=101351
'
Dim TmpFile As String, myBDT As String, PubFile
TmpFile = "C:\DIR\" & "Testo.htm"       'Vedi testo
'Crea file html:
With ThisWorkbook.PublishObjects.Add(SourceType:=xlSourceRange, _
    Filename:=TmpFile, _
    Sheet:=mySh, _
    Source:=PRan, _
    HtmlType:=xlHtmlStatic)
    .Publish (True)
End With
'
Set fso = CreateObject("Scripting.FilesystemObject")
Set PubFile = fso.OpenTextFile(TmpFile, 1, False)
  RangePublish = PubFile.ReadAll
PubFile.Close
'
End Function

Macro 3 - creare le e-mail dall'elenco e le salva in un folder di appoggio (Foder: Processate) con testo in Foglio2

Codice: Seleziona tutto

Sub Salva_in_folder_di_appoggio()
Dim OutApp As Object, OutMail As Object
Dim EmailAddr As String, Subj As String
Dim K As Long

'DA QUI SI CREA LA MAIL:
Set OutApp = CreateObject("Outlook.Application")
Foglio1.Select
' RR contiene il numero di utenti cui inviare le e-mail (1 per utente)
    RR = Range("B" & Rows.Count).End(xlUp).Row
     
' I dati iniziano dalla seconda riga
    For I = 2 To RR
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
             
        With OutMail
        .Display
' La colonna "B" contiene gli indirizzi e-mail dei vari destinatari
               .To = Cells(I, 2)
               
' La colonna "C" contiene l'indirizzo e-mail in "Copia per Conoscenza"
               .CC = Cells(I, 3)
               
' La colonna "D" contiene l'eventuale e-mail in "Copia per conoscenza nascosta"
               .BCC = Cells(I, 4)   'Togliere l'apice davanti al punto se si vuole inserire un indirizzo
               
' La colonna "E" contiene l'oggetto della e-mail
               .Subject = Cells(I, 5)
               
' La colonna "F" contiene l testo della e-mail oppure un range di celle nel Foglio1 o nel Foglio 2
               .HTMLBody = "<table align=left>" & RangePublish("Foglio2", "A1:T21") & .HTMLBody

' La colonna "G" contiene il percorso ove si trova il file da allegare
' La colonna "H" contiene il nome del file da allegare
                On Error Resume Next
               .Attachments.Add (Cells(I, 7) & Cells(I, 8))
     
    .Display
    '.Send
                             
                Dim proCd As MAPIFolder
                Dim myNameSpace As Namespace
                Set myNameSpace = Outlook.GetNamespace("MAPI")
                Set proCd = myNameSpace.Folders("enrico.banco@email.it").Folders("Inbox").Folders("Processate") ‘inserire e-mail
                OutMail.Move proCd
                                       
                                       
        End With
        K = K + 1
        Set OutMail = Nothing
        Set OutApp = Nothing
        'Application.SendKeys "%a"
    Next I
    MsgBox ("Completato; (" & K & " messaggi)")
End Sub


‘RangePublish
Function RangePublish(ByVal mySh As String, ByVal PRan As String) As Variant
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=101351
'
Dim TmpFile As String, myBDT As String, PubFile
TmpFile = "C:\DIR\" & "Testo.htm"       'Vedi testo
'Crea file html:
With ThisWorkbook.PublishObjects.Add(SourceType:=xlSourceRange, _
    Filename:=TmpFile, _
    Sheet:=mySh, _
    Source:=PRan, _
    HtmlType:=xlHtmlStatic)
    .Publish (True)
End With
'
Set fso = CreateObject("Scripting.FilesystemObject")
Set PubFile = fso.OpenTextFile(TmpFile, 1, False)
  RangePublish = PubFile.ReadAll
PubFile.Close
'
End Function

Macro 4 - inviare e-mail salvate in un folder di appoggio con testo in Foglio2

Codice: Seleziona tutto

Sub Invia_Tutte_Dopo_Controllo()
'Invia tutte le e-mail salvate in un folder di appoggio
'Apre Outlook
'Application.ActivateMicrosoftApp xlMicrosoftMail

Dim proCd As MAPIFolder
Dim myNameSpace As Namespace, myMex As MailItem
Dim I As Long
'
Set myNameSpace = Outlook.GetNamespace("MAPI")
Set proCd = myNameSpace.Folders("enrico.banco@email.it ").Folders("Inbox").Folders("Processate")      '<<< Folder si destinazione'
'
For J = proCd.Items.Count To 1 Step -1
    Set myMex = proCd.Items(J)
    If TypeOf myMex Is MailItem Then
        myMex.Send
        myWait (0.5)
        I = I + 1
    End If
Next J
MsgBox ("Completato; (" & I & " messaggi)")
End Sub

Sub myWait(myStab As Single)
Dim myStTiM As Single
  myStTiM = Timer
 Do          'wait myStab
 DoEvents
If Timer > myStTiM + myStab Or Timer < myStTiM Then Exit Do
Loop
End Sub

Macro 5 - Apre file Word che contiene una macro Word (Macro 6) che crea file htm

Codice: Seleziona tutto

Sub Apri_file_word_per_testo_email()
'Apre file word che contiene macro per salvare file in htm
'Il file salvato presenta testo allineato a sinistra in modo corretto per invio e-mail
    Dim WordApp As Object
    Set WordApp = CreateObject("Word.Application")
    WordApp.Documents.Open "C:\DIR\Testo_per_email.docx"
    WordApp.Visible = True
    Set WordApp = Nothing
End Sub

Macro 6 - Macro Word che crea file htm

Codice: Seleziona tutto

Sub Testo_per_email()
'Crea file in htm per testo allineato a sinistra in e-mail
        ChangeFileOpenDirectory _
        "C:\DIR\"
    ActiveDocument.SaveAs2 FileName:="Testo.htm", FileFormat:=wdFormatHTML, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, CompatibilityMode:=0
    ActiveWindow.View.Type = wdWebView
End Sub

Macro 7 - Crea le e-mail dall'elenco e le salva in un folder di appoggio con testo da Word

Codice: Seleziona tutto

Sub Draft_con_Testo_Word ()
'Usa la funzione GetBoiler

Dim OutApp As Object, OutMail As Object
Dim EmailAddr As String, Subj As String
Dim K As Long

 'GetBoiler
 firme = "C:\DIR\Testo.htm"
     If Dir(firme) <> "" Then
       signature = GetBoiler(firme)
    Else
        signature = ""
    End If

'DA QUI SI CREA LA MAIL:
Set OutApp = CreateObject("Outlook.Application")

Foglio1.Select

' RR contiene il numero di utenti cui inviare le e-mail (1 per utente)
    RR = Range("B" & Rows.Count).End(xlUp).Row
     
' I dati iniziano dalla seconda riga
    For I = 2 To RR
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
             
        With OutMail
        .Display
' La colonna "B" contiene gli indirizzi e-mail dei vari destinatari
               .To = Cells(I, 2)
               
' La colonna "C" contiene l'indirizzo e-mail in "Copia per Conoscenza"
               .CC = Cells(I, 3)
               
' La colonna "D" contiene l'eventuale e-mail in "Copia per conoscenza nascosta"
               .BCC = Cells(I, 4)   'Togliere l'apice davanti al punto se si vuole inserire un indirizzo
               
' La colonna "E" contiene l'oggetto della e-mail
               .Subject = Cells(I, 5)
               
' La colonna "F" contiene l testo della e-mail oppure un range di celle nel Foglio1 o nel Foglio 2
               .HTMLBody = "<table align=left>" & signature & .HTMLBody
           

' La colonna "G" contiene il percorso ove si trova il file da allegare
' La colonna "H" contiene il nome del file da allegare
                On Error Resume Next
               .Attachments.Add (Cells(I, 7) & Cells(I, 8))
     
    .Display
    '.Send
                             
                Dim proCd As MAPIFolder
                Dim myNameSpace As Namespace
                Set myNameSpace = Outlook.GetNamespace("MAPI")
                Set proCd = myNameSpace.Folders("enrico.banco@email.it").Folders("Inbox").Folders("Processate")
                OutMail.Move proCd
                                       
                                       
              myWait (0.3) 'Aggiunta Sub myWait
             
        End With
        K = K + 1
        Set OutMail = Nothing
        Set OutApp = Nothing
        'Application.SendKeys "%a"
    Next I
    MsgBox ("Completato; (" & K & " messaggi)")
End Sub

Sub myWait(myStab As Single)

'Aggiunta Sub myWait

Dim myStTiM As Single
  myStTiM = Timer
    Do          'wait myStab
       DoEvents
       If Timer > myStTiM + myStab Or Timer < myStTiM Then Exit Do
    Loop
End Sub


'GetBoiler
Function GetBoiler(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.ReadAll
    ts.Close
End Function

[Anthony47]

Grazie per il feedback, ma non ho capito quali cose ancora non vanno.

[EnricoBanco]

Ciao,
funziona tutto.
La mia osservazione era solo una curiosità: perchè se si riesce ad inserire nel file htm creato con RangePublish o GetBoiler un elemento grafico qualsiasi poi questo elemento grafico non viene riportato nel testo dell’e-mail, neanche se si allega il relativo file?
Nel testo dell'e-mail viene riportato correttamente tutto il testo presente nel file htm ma al posto dell'elemento grafico compare il riquadro bianco con la dicitura "impossibile trovare il file"

[Anthony47]

Hummm...
Il file C:\Users\NomeDellUTENTE\AppData\Local\Temp\myBD.htm CONTIENE l'immagine in formato binario; infatti essa e' visibile se si apre quel file con un browser.
Questo contenuto binario viene perduto quando si fa poi la OpenTextFile().ReadAll

Devo capire come poter mantenere questo contenuto...

Ciao

[EnricoBanco]

Sto cercando anche io, a questo argomento: VBA- Formatting email Body from excel contents
ho trovato su https://stackoverflow.com/ i segueti links:

1) https://stackoverflow.com/questions/288 ... l-contents
2) https://stackoverflow.com/questions/161 ... excel-2003

Il 1) contiene il link al 2). Provo...

[Anthony47]

In tutti gli esempi con immagine io ho visto che viene usata la tecnica di "allegare" l'immagine e referenziarla all'interno del corpo della mail col tag + attibuto, tipo
<img src='cid:NomeImmagine.jpg'>

Stranamente il mitico Ron Debruin non scrive niente al riguardo, ne' a conferma ne' per proporre qualcosa di alternativo.

Purtroppo non ho ancora capito come si potrebbero legare il corpo ottenuto con RangePublish (o altra tecnica) con la riga addizionale da inserire; devo dire che non mi sono applicato troppo, quindi forse ho ancora qualche chance di capirlo

Ciao

[EnricoBanco]

Ciao Anthony, grazie mille. Ho cercato ancora e su questo sito:
http://excel-macro.tutorialhorizon.com/ ... ing-excel/
ho trovato questo esempio che riporto integralmente:

Codice: Seleziona tutto

Sub sumit()
Dim mainWB As Workbook
Dim SendID
Dim CCID
Dim Subject
Dim Body
Dim olMail As MailItem

Set otlApp = CreateObject("Outlook.Application")
Set olMail = otlApp.CreateItem(olMailItem)
Set Doc = olMail.GetInspector.WordEditor
'Dim colAttach As Outlook.Attachments
Dim oAttach As Outlook.Attachment

Set mainWB = ActiveWorkbook

SendID = mainWB.Sheets("Mail").Range("B1").Value
CCID = mainWB.Sheets("Mail").Range("B2").Value
Subject = mainWB.Sheets("Mail").Range("B3").Value
Body = mainWB.Sheets("Mail").Range("B4").Value
With olMail
    .To = SendID
    If CCID <> "" Then
      .CC = CCID
    End If
    .Subject = Subject
    'add the image in hidden manner, position at 0 will make it hidden
    .Attachments.Add "C:\Users\Sumit Jain\Pictures\11\city.jpg", olByValue, 0

    'Now add it to the Html body using image name
    'change the src property to 'cid:your image filename'
    'it will be changed to the correct cid when its sent.
    .HTMLBody = .HTMLBody & "<br><B>Embedded Image:</B><br>" _
                & "<img src='cid:city.jpg'" & "width='500' height='200'><br>" _
                & "<br>Best Regards, <br>Sumit</font></span>"
    .Display
    .Send
End With

MsgBox ("you Mail has been sent to " & SendID)

End Sub


Funziona e l''ho adatta alla "Macro 3 - creare le e-mail dall'elenco e le salva in un folder di appoggio (Folder: Processate) con testo in Foglio2" qui rinominata "Sub Inserisce_anche_grafica_in_testo_email". Questo esempio utilizza il metodo "Embedded Image" aggiungendo:

Codice: Seleziona tutto

'Metodo Embedded Image
.Attachments.Add "C:\DIR\Prova.jpg", olByValue, 0

Codice: Seleziona tutto

.HTMLBody = "<table align=left>" & RangePublish("Foglio2", "A1:T21") & "<br><B>Ecco la grafica:</B><br>" _
                & "<img src='cid:Prova.jpg'" & "width='500' height='200'><br>" _
                & "<br>Ciao <br>EnricoBanco</font></span>" & .HTMLBody

Quindi in sintesi riesce da inserire una grafica da file esterno nel testo dell'e-mail. Non risolve il problema...Però se si vuole inserire una grafica presa da file esterno nel testo dell'e-mail questo esempio...Funziona. Può essere utile.

Codice: Seleziona tutto

Sub Inserisce_anche_grafica_in_testo_email()

'Pulsante "Crea le e-mail dall'elenco e le salva in un folder di appoggio con testo in Foglio2"
'Funziona: inserisce il contenuto del file testo.htm (ma non riesce ad inserire una grafica se nel range celle di excel) nel testo dell'e-'mail. Inserisce firma con grafica. Inserisce grafica in testo e-mail presa da file esterno


Dim OutApp As Object, OutMail As Object
Dim EmailAddr As String, Subj As String
Dim K As Long

'DA QUI SI CREA LA MAIL:
Set OutApp = CreateObject("Outlook.Application")

Foglio1.Select

' RR contiene il numero di utenti cui inviare le e-mail (1 per utente)
    RR = Range("B" & Rows.Count).End(xlUp).Row
     
' I dati iniziano dalla seconda riga
    For I = 2 To RR
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
             
        With OutMail
        .Display
' La colonna "B" contiene gli indirizzi e-mail dei vari destinatari
               .To = Cells(I, 2)
               
' La colonna "C" contiene l'indirizzo e-mail in "Copia per Conoscenza"
               .CC = Cells(I, 3)
               
' La colonna "D" contiene l'eventuale e-mail in "Copia per conoscenza nascosta"
               .BCC = Cells(I, 4)   'Togliere l'apice davanti al punto se si vuole inserire un indirizzo
               
' La colonna "E" contiene l'oggetto della e-mail
               .Subject = Cells(I, 5)
               
               'Metodo Embedded Image
               .Attachments.Add "C:\DIR\Prova.jpg", olByValue, 0
               
' La colonna "F" contiene l testo della e-mail oppure un range di celle nel Foglio1 o nel Foglio 2
              .HTMLBody = "<table align=left>" & RangePublish("Foglio2", "A1:T21") & "<br><B>Ecco la grafica:</B><br>" _
                & "<img src='cid:Prova.jpg'" & "width='500' height='200'><br>" _
                & "<br>Ciao <br>EnricoBanco</font></span>" & .HTMLBody

' La colonna "G" contiene il percorso ove si trova il file da allegare
' La colonna "H" contiene il nome del file da allegare
                On Error Resume Next
               .Attachments.Add (Cells(I, 7) & Cells(I, 8))
             

    .Display 'Il .Display funziona correttamente se si mette l'apice a Application.SendKeys "%a"
    '.Send
                             
                Dim proCd As MAPIFolder
                Dim myNameSpace As Namespace
                Set myNameSpace = Outlook.GetNamespace("MAPI")
                Set proCd = myNameSpace.Folders("EnricoBanco@EnricoBanco.it").Folders("Inbox").Folders("Processate")
                OutMail.Move proCd
                                       
        End With
        K = K + 1
        Set OutMail = Nothing
        Set OutApp = Nothing
        'Application.SendKeys "%a"
    Next I
    MsgBox ("Completato; (" & K & " messaggi)")
End Sub


Function RangePublish(ByVal mySh As String, ByVal PRan As String) As Variant
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=101351
'
Dim TmpFile As String, myBDT As String, PubFile
TmpFile = "C:\DIRl\" & "Testo.htm"       'Vedi testo
'Crea file html:
With ThisWorkbook.PublishObjects.Add(SourceType:=xlSourceRange, _
    Filename:=TmpFile, _
    Sheet:=mySh, _
    Source:=PRan, _
    HtmlType:=xlHtmlStatic)
    .Publish (True)
End With
'
Set fso = CreateObject("Scripting.FilesystemObject")
Set PubFile = fso.OpenTextFile(TmpFile, 1, False)
  RangePublish = PubFile.ReadAll
PubFile.Close
'
End Function

[EnricoBanco]

Però così inserisce lo stesso file grafico nella lista e-mail, sarebbe interessante poter personalizzare ciascuna e-mail della lista con il proprio elemento grafico. Ho provato anche così e sembra funzionare:

Codice: Seleziona tutto

'Metodo Embedded Image
.Attachments.Add (Cells(I, 7) & Cells(I, 8)), olByValue, 0

Ma l'img src nel .HTMLBody comunque considera il file "Prova.jpg" per tutte le e-mail della lista.
Ci provo

[EnricoBanco]

Però così inserisce lo stesso file grafico nella lista e-mail, sarebbe interessante poter personalizzare ciascuna e-mail della lista con il proprio elemento grafico. Ho provato anche così e sembra funzionare:

Codice: Seleziona tutto

'Metodo Embedded Image
.Attachments.Add (Cells(I, 7) & Cells(I, 8)), olByValue, 0

Ma l'img src nel .HTMLBody comunque considera il file "Prova.jpg" per tutte le e-mail della lista.
Ci provo

[EnricoBanco]

Ho provato in questo modo ma non inserisce una grafica dedicata nel testo di ciuascuna e-mail (il resto del processo funziona), anche se cambio con ".Attachments.Add "C:\Users\00220420\Desktop\Invio elenco e-mail con file allegato - Macro VBA Excel\Prova.jpg", olByValue, 0":

Codice: Seleziona tutto

'Metodo Embedded Image
              .Attachments.Add (Cells(I, 7) & Cells(I, 9)), olByValue, 0                                     
              '.Attachments.Add "C:\Users\00220420\Desktop\Invio elenco e-mail con file allegato - Macro VBA Excel\Prova.jpg", olByValue, 0

' La colonna "F" contiene l testo della e-mail oppure un range di celle nel Foglio1 o nel Foglio 2
               .HTMLBody = "<table align=left>" & RangePublish("Foglio2", "A1:T21") & "<br><B>Ecco la grafica:</B><br>" _
                & "<img src=.Attachments.Add (Cells(I, 7) & Cells(I, 9))>" _
                & "<br>Ciao <br>EnricoBanco</font></span>" & .HTMLBody

In questo post:
https://www.emailarchitect.net/forum/ya ... mages.aspx
ho trovato un altro modo ed il risultato è che nella grafica nel testo dell'e-mail inserisce la grafica della firma. Allora la domanda è come faccio a dirgli di puntare (come ho provato a fare sopra) all'elenco file.jpg del file xls?

Codice: Seleziona tutto

'Metodo Embedded Image
              .Attachments.Add (Cells(I, 7) & Cells(I, 9)), olByValue, 0
              '.Attachments.Add "C:\Users\00220420\Desktop\Invio elenco e-mail con file allegato - Macro VBA Excel\Prova.jpg", olByValue, 0

' La colonna "F" contiene l testo della e-mail oppure un range di celle nel Foglio1 o nel Foglio 2
               .HTMLBody = "<table align=left>" & RangePublish("Foglio2", "A1:T21") & "<br><B>Ecco la grafica:</B><br>" _
                & "<img src=""cid:" & cid & """ >" _
                & "<br>Ciao <br>EnricoBanco</font></span>" & .HTMLBody

[Anthony47]

Non ti sto seguendo negli esperimenti.
Il codice per inserire una immagine "in linea col testo" mi e' chiaro; quel che ora a me interessa e' creare una NuovaRangePublish che al suo interno abbia la logica per creare un html idoneo per la mail (l'attuale RangePublish gia' crea un codice leggibile tramite browser, completo di eventuali parti grafiche), e su questo fronte non ho ancora capito come poter posizionare le parti grafiche all'interno del codice html creato dall'attuale RangePublish, nell'esatta posizione.

Inoltre tieni presente che solo nel caso di immagini "linkate" si puo' risalire al jpg originale; nel caso di immagini "integrate" questo link viene perso al primo File Save.

Nell'ultimo messaggio leggo

ma non inserisce una grafica dedicata nel testo di ciuascuna e-mail (il resto del processo funziona), anche se cambio con ".Attachments.Add "C:\Users\00220420\Desktop\Invio elenco e-mail con file allegato - Macro VBA Excel\Prova.jpg", olByValue, 0"

La sequenza giusta e' del tipo

Codice: Seleziona tutto

    .Attachments.Add "C:\Dir\NomeImmagine.jpg"

e poi inserire nel corpo della tua mail (che deve essere in html) la stringa

Codice: Seleziona tutto

<p>NomeImmagine</p>" & "<img src='cid:NomeImmagine.jpg' >"

Quanto alla grafica nella firma, perche' vuoi farlo fare alla macro quando questa e' una prestazione resa disponibile da Outlook?

Ciao

[EnricoBanco]

Ok, grazie mille, avevo trovato questo metodo in un post che ho riportato poco sopra con l'adattamento della macro applicando quello che stai dicendo tu e funziona perfettame te. Quindi se ho capito bene l'unico modo per inserire una grafica nel testo dell'e-mail è questo che punta ad un file specifico.

Quello che stavo provando era ciclare ogni e-mail con la sua grafica dedicata e non con una sola grafica valida per tutte le e-mail. Però ho capito che non si puó fare se non con la RangePublish...O la futura nuova RangePublish.
Ho capito bene?

Sulla "firma" è tutto chiaro mi sono espresso male io. Ciao, grazie mille

[EnricoBanco]

Ok, grazie mille, avevo trovato questo metodo in un post che ho riportato poco sopra con l'adattamento della macro applicando quello che stai dicendo tu e funziona perfettame te. Quindi se ho capito bene l'unico modo per inserire una grafica nel testo dell'e-mail è questo che punta ad un file specifico.

Quello che stavo provando era ciclare ogni e-mail con la sua grafica dedicata e non con una sola grafica valida per tutte le e-mail. Però ho capito che non si puó fare se non con la RangePublish...O la futura nuova RangePublish.
Ho capito bene?

Sulla "firma" è tutto chiaro mi sono espresso male io. Ciao, grazie mille