Moses_BAM
07-12-2017, 12:53 PM
Hello, I could use some help with my code below. every time the email is generated the image is completely blurry nothing is legible.
Application.ScreenUpdating = False
Dim OLapp As Outlook.Application
Dim OLEmail As Outlook.MailItem
Dim OLInsp As Outlook.Inspector
Dim wdDoc As Word.Document
Set OLapp = New Outlook.Application
Set OLEmail = OLapp.CreateItem(olMailItem)
With OLEmail
.BodyFormat = olFormatHTML
.Display
.To = ""
.Subject = Sheets("Sheet7").Range("T10").Value
Set OLInsp = .GetInspector
Set wdDoc = OLInsp.WordEditor
Sheet3.Activate
Application.CopyObjectsWithCells = False
Range("A4", "L4").CurrentRegion.CopyPicture Appearance:=xlScreen, Format:=xlPicture
wdDoc.Range.Paste
Application.CutCopyMode = False
Dim shp As Object
For Each shp In wdDoc.InlineShapes
shp.ScaleHeight = 49
shp.ScaleWidth = 49
Next
End With
End Sub
Application.ScreenUpdating = False
Dim OLapp As Outlook.Application
Dim OLEmail As Outlook.MailItem
Dim OLInsp As Outlook.Inspector
Dim wdDoc As Word.Document
Set OLapp = New Outlook.Application
Set OLEmail = OLapp.CreateItem(olMailItem)
With OLEmail
.BodyFormat = olFormatHTML
.Display
.To = ""
.Subject = Sheets("Sheet7").Range("T10").Value
Set OLInsp = .GetInspector
Set wdDoc = OLInsp.WordEditor
Sheet3.Activate
Application.CopyObjectsWithCells = False
Range("A4", "L4").CurrentRegion.CopyPicture Appearance:=xlScreen, Format:=xlPicture
wdDoc.Range.Paste
Application.CutCopyMode = False
Dim shp As Object
For Each shp In wdDoc.InlineShapes
shp.ScaleHeight = 49
shp.ScaleWidth = 49
Next
End With
End Sub