![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Microsoft 365 e Office | Excel | Per il lavoro | Android
Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione di dati
Ciao Federico,
Prima di tutto la ringrazio per la sua tempestiva risposta al mio quesito,
Dunque, posto di seguito il codice (VBA) di invio email ma credo che sia del tutto inutile in quanto si tratta di una procedura standard ( una sub per intenderci) alla quale passo come parametri l'oggetto dell'email, i destinatari per competenza e conoscenza, il percorso completo del file Excel da allegare, la stringa del body dell'email ecc. ecc. ...
Public Sub SendEMail(ByVal strHTMLMailBody As String, ByVal strEMailAddressees As String, ByVal strEMailAttachment As String, bla bla bla ... )
Dim objOutlookApp As Object
Dim objMail As Object
Set objOutlookApp = CreateObject("Outlook.Application")
Set objMail = objOutlookApp.CreateItem(olMailItem)
With objMail
.To = strEMailAddressees
.Subject = "Test invio email"
.Attachments.Add (strEMailAttachment)
.BodyFormat = olFormatHTML
.HTMLBody = strHTMLMailBody
...
bla .. bla ..bla ... bla ...
...
.Display
' .Send
End With
End Sub
Infatti il mio problema non è l'invio dell'email che viene inviata correttamente ma è la formattazione della tabella riepilogativa nel body dell'email che Outlook altera se utilizzo il metodo display, per esempio l'head della tabella perde il colore dello sfondo impostato (background-color) gli attributi dei bordi non sono quelli che ho impostato ecc. ecc.
Il body dell'email non è altro che il testo del codice HTML , questo contiene delle variabili di riferimento che per il codice HTML non sono null'altro che testo e che in breve vado a rimpiazzare tramite la funzione Replace di VBA con i valori da includere nella tabella riepilogativa; la sostituzione la eseguo fuori dalla Sub SendEMail(), a questa gli passo come parametro il testo html completo di tutti i valori ...
Il testo HTM del body dell'email è memorizzato in una cella Excel
Se dunque nella Sub SendEMail() uso direttamente il metodo .send e non uso il metodo .display la tabella riepilogativa nel body viene inviata correttamente se invece utilizzo il metodo display (quindi l'invio dovrà essere comandato manualmente nell'anteprima dell'email) la tabella riepilogativa subisce un'alterazione,
Che la causa sia outlook ((della suite Microsoft Office 2021 Professional plus) è evidente ...
Purtroppo in ufficio utilizziamo outlook per le emails e comunque l'anteprima dell'email è necessaria perché di volta in volta capita di dover aggiungere nel body dell'email qualche breve nota del caso
Sfortunatamente, non hai incluso né un esempio dei tuoi dati né il codice che usi per passare l'intervallo HTML alla tua funzione.
Per testare il tuo codice sarà necessario pubblicare tutto il codice rilevante e fornire dei dati di esempio.
In attesa di un file, privo di dati sensibili, il tipo di codice che solitamente utilizzo è:
'========>>
Option Explicit
'-------->>
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Const sFoglio As String = **"Foglio1" '<<=== Modifica**
Const sIntervallo As String = **"A1:A24" '<<=== Modifica**
Const sDestinatario As String = **"pippoCHIOCCIOLAgmail.com" '<<=== Modifica**
Const sOggetto As String = **"Esempio\_Mail\_HTML" '<<=== Modifica**
Set WB = ThisWorkbook
Set SH = WB.Sheets(sFoglio)
Set Rng = SH.Range(sIntervallo)
Call Invia\_Mail\_HTML(Rng, sDestinatario, sOggetto)
End Sub
'-------->>
Public Sub Invia_Mail_HTML(oRng As Range, sRecipient As String, sSubject As String)
Dim oOutlook As Object
Dim oMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set oOutlook = CreateObject("Outlook.Application")
Set oMail = oOutlook.CreateItem(0)
On Error Resume Next
With oMail
.To = sRecipient
.CC = ""
.BCC = ""
.Subject = sSubject
.HTMLBody = RangetoHTML(oRng)
.Display '\\ .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set oMail = Nothing
Set oOutlook = Nothing
End Sub
'--------->>
Public Function RangetoHTML(Rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
Rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( \_
SourceType:=xlSourceRange, \_
FileName:=TempFile, \_
Sheet:=TempWB.Sheets(1).Name, \_
Source:=TempWB.Sheets(1).UsedRange.Address, \_
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", \_
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
'<<========
Eseguendo questo codice con un semplice file di prova, io ottengo un anteprima dell'email del seguente genere:
[
.
===
Regards,
Norman