Hoi,
Ik genereer met VBA een mail met de code van Ron de Bruin (https://www.rondebruin.nl/).
Deze code heb ik aangepast zodat het specifieke (variabele) gegevens uit de excelsheet haalt.
Nu heb ik inmiddels een handtekening onder het geheel gebouwd. Hierbij heb ik de kleur van Met vriendelijke groeten naar wens aangepast.
Wat ik niet voor elkaar krijg is om de naam van de verzender in kleur te tonen. De naam van de verzender (Range("C25").Text) is een verwijzing naar een cel in de sheet. Deze is variabel.
Nergens kan ik iets vinden om de kleur hiervan aan te passen. (Zelfs niet om de betreffende cel als zo danig op te maken )
Het lijkt hem in het woord .text te zitten. Als daar bv .character staat kan er een Font.color = RGB(31, 73, 125) achteraan, maar met .text lijkt dat niet te lukken.
Wie heeft een oplossing hiervoor: via helpmij forum en google kan ik niet de oplossing vinden.
Dit is de
Dit is de complete code om de mail te genereren:
Ik genereer met VBA een mail met de code van Ron de Bruin (https://www.rondebruin.nl/).
Deze code heb ik aangepast zodat het specifieke (variabele) gegevens uit de excelsheet haalt.
Nu heb ik inmiddels een handtekening onder het geheel gebouwd. Hierbij heb ik de kleur van Met vriendelijke groeten naar wens aangepast.
Wat ik niet voor elkaar krijg is om de naam van de verzender in kleur te tonen. De naam van de verzender (Range("C25").Text) is een verwijzing naar een cel in de sheet. Deze is variabel.
Nergens kan ik iets vinden om de kleur hiervan aan te passen. (Zelfs niet om de betreffende cel als zo danig op te maken )
Het lijkt hem in het woord .text te zitten. Als daar bv .character staat kan er een Font.color = RGB(31, 73, 125) achteraan, maar met .text lijkt dat niet te lukken.
Wie heeft een oplossing hiervoor: via helpmij forum en google kan ik niet de oplossing vinden.
Dit is de
Code:
' 1e Deel Groet gevolgd door naam.
strbody = "<b><span style='color:#1F497D'>Met vriendelijke groeten</span></b>, <br><br>" & _
Range("C25").Text
' 2e Deel waar e.e.a. wordt samengevoegd
.HTMLBody = RangetoHTML(MyHTMLRng) & "<br><br>" & strbody & "<br>" & _
"<img src=\\<padnaam_zonder_spaties\sig_adres.png height=’732' width=’164’>"
Dit is de complete code om de mail te genereren:
- 1e sub: Selecteer het te mailen gedeelte en kopieer en plak waarden omdat formules anders niet in de mail komen (dat wordt dan #WAARDE)
- 2e sub: Hier wordt de mail aangemaakt met gegevens uit de excelsheet + de handtekening (samengesteld met strbody en een plaatje (op een share) om af te zijn van het invoegen van een logo op de juiste plek in de handtekening)
- 3e sub: Code van Rn de Bruin, niks aan gewijzigd
Code:
Sub Genereer_Email_met_testresultaat2()
' Deze macro selecteert eerst een gebied gegevens en kopieert en plakt de waarden in dezelfde velden.
' omdat deze onderstaande macro formule waarden niet kan omzetten.
Sheets("Overzicht_Email").Select
lastRow = ActiveSheet.UsedRange.Rows.Count
Range("B12", "F" & lastRow + 0).Select
Selection.Copy
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Alter Send Email Sub Procedure Details in order
'To Modify Subject, Recipients...etc...
'The range put in this Sub is....the one that will be
'put into the email... i.e. This puts A1:G21 in the email
Call SendEmail(Sheets("Overzicht_Email").Range("B12", "F" & ActiveSheet.UsedRange.Rows.Count - 1))
End Sub
Sub SendEmail(MyHTMLRng As Range)
' Changed by Ron de Bruin (https://www.rondebruin.nl/) 28-Oct-2006
Dim OutApp As Object
Dim OutMail As Object
Dim OutlookOpened As Boolean
Dim strbody As String
OutlookOpened = False
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
OutlookOpened = True
End If
Set OutMail = OutApp.CreateItem(0)
'Dit deel is toegevoegd om de handtekening toe te voegen
'Kleur tekst zou moeten zijn: Font.color = RGB(31, 73, 125)
strbody = "<b><span style='color:#1F497D'>Met vriendelijke groeten</span></b>, <br><br>" & _
Range("C25").Text
On Error Resume Next
With OutMail
.Display 'allows email to be displayed and checked before manually sending it
.To = Range("C9").Text
.CC = Range("C10").Text
.Subject = "Testrapportage: " & Range("M1").Text & " - " & Range("C18").Text
' Excel rapportage + naam tester + handtekening plaatje
.HTMLBody = RangetoHTML(MyHTMLRng) & "<br><br>" & strbody & "<br>" & _
"<img src=\\zkh\appdata\WPBT\Tooling\Handtekening_Testrapportage\sig_adres.png height=’732' width=’164’>"
'.Send 'express uitgezet om de mail voor verzenden nog te wijzigen. This sends the email direct from Excel
End With
On Error GoTo 0
Set OutMail = Nothing
If OutlookOpened Then OutApp.Quit
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010-O365
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