leostamato
New Member
- Joined
- Nov 7, 2018
- Messages
- 2
Code:
Sub CommentsEmail()
Dim template As Workbook
Dim dashboard As Worksheet
Dim comments As Worksheet
Dim OutApp As Object
Dim OutMail As Object
Dim olApp As Outlook.Application
Dim mymail As Outlook.mailItem
Dim objSel As Word.Selection
Dim commentsrange As Range
Dim branch As String
Dim Sendto As String
UpdateScreen = False
Shell ("Outlook")
Set olApp = New Outlook.Application
Set mymail = olApp.CreateItem(olMailItem)
Set template = ActiveWorkbook
Set dashboard = template.Worksheets("Dashboard")
Set comments = template.Worksheets("Comments")
branch = dashboard.Cells(1, 25)
Sendto = comments.Cells(2, 10)
Set commentsrange = comments.Range(Cells(7, 1), Cells(52, 4))
template.Activate
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'OutMail.Display
Dim wordDoc As Word.Document
Set wordDoc = OutMail.GetInspector.WordEditor
Set objSel = wordDoc.Windows(1).Selection
'construct the body of the email here
With objSel
'first text
.InsertAfter "Dear All," & vbCrLf
.Move wdParagraph, 1
'second text
.InsertAfter vbCrLf & "See below the Comments for Flash Indicator - " & branch & vbCrLf & vbCrLf
.Move wdParagraph, 1
'copy a range and paste a picture
commentsrange.Copy ''again, you need to modify your target range
.PasteAndFormat wdChartPicture
.Move wdParagraph, 1
.InsertAfter vbCrLf & "Let us know of any questions." & vbCrLf & vbCrLf
.Move wdParagraph, 1
.InsertAfter vbCrLf & "Kind Regards," & vbCrLf
End With
OutMail.To = OutMail.To & ";" & Sendto
With OutMail
.Subject = "Comments on Flash Indicator Results - " & branch
.Attachments.Add (ActiveWorkbook.FullName)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Exit Sub
End Sub
Last edited by a moderator: