Eric Penfold
Active Member
- Joined
- Nov 19, 2021
- Messages
- 431
- Office Version
- 365
- Platform
- Windows
- Mobile
The code sends a word doc email but the text in the word doc is blurry how could improve the text quality?
VBA Code:
Option Explicit
Sub SendDailyMailEmail()
Dim wb As Workbook
Dim ws As Worksheet
Dim Tbl As Range
Dim LRow As Long
Dim EmailApp As Object, EmailItem As Object
Dim Pic As Picture
Dim Shape1 As shape, Shape2 As shape
Dim MyShp As shape
Dim WordDoc
Set EmailApp = CreateObject("Outlook.Application")
Set EmailItem = EmailApp.CreateItem(0)
Set wb = Workbooks("MyPersonal.xlsb")
Set ws = wb.Sheets("DailyMail")
LRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set Tbl = ws.Range("A1:Q" & LRow)
ws.Activate
Tbl.Copy
Set Pic = ws.Pictures.Paste
Pic.Select
Pic.Cut
With EmailItem
.to = ""
.Subject = "Drainfast Daily Mail" & " " & Format(Date, "dd-mm-yy")
.Display
Set WordDoc = EmailItem.GetInspector.WordEditor
With WordDoc.Range
.InsertParagraphafter
.PasteAndFormat 13
.Application.Selection.TypeText Text:=""
.Application.Selection.HomeKey unit:=5, Extend:=1
.Application.Selection.EndKey unit:=6
.Hyperlinks.Add Anchor:=.Application.Selection.Range, Address:= _
"https://app.smartsheet.com/b/form/05bee75bfa6a47b7b5c5cff74e64dc3d", SubAddress:="", ScreenTip:="", TextToDisplay:="Brainstorm Suggestions"
.Application.Selection.TypeText Text:=" - "
.Hyperlinks.Add Anchor:=.Application.Selection.Range, Address:= _
"\\somepath\filename.xlsx", SubAddress:="", ScreenTip:="", TextToDisplay:="Product Ideas"
.Application.Selection.HomeKey unit:=5, Extend:=1
.Application.Selection.ParagraphFormat.Alignment = 1
.InsertParagraphafter
.InsertParagraphafter
.InsertAfter "Kind Regards,"
End With
End With
On Error GoTo 0
Set EmailItem = Nothing
Set EmailApp = Nothing
End Sub