Code to reply all with same subject in email

usermd79

New Member
Joined
Feb 4, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
VBA Code:
Sub CreateMail()
Call spcheck2

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngBody As Range
Dim outMail As Outlook.MailItem.Reply 'new
Email = Worksheets("Email List").Range("B2")
EmailCC = Worksheets("Email List").Range("B8")

Set objOutlook = CreateObject("Outlook.Application")

Set objMail = objOutlook.CreateItem(0)
Set outMail = objOutlook.CreateItem(olMailItem)


With Sheets("Report")
Set rngBody = .Range("A1:G20")

End With
rngBody.Copy

With objMail
.To = Email
.CC = EmailCC
.Subject = Range("D1") & " " & "EOS" & " Brazing Lead Report " & Range("B1").Value [COLOR=rgb(184, 49, 47)]Need the code to find EOS in outlook and reply all from previous email[/COLOR]
.Display

'outMail.Display
Dim wordDoc As Word.Document
Set wordDoc = .GetInspector.WordEditor ' or use outMail instead of with()
wordDoc.Range.PasteandFormat wdChartPicture
For Each shp In wordDoc.InlineShapes
shp.ScaleHeight = 95
shp.ScaleWidth = 105
Next

End With
'SendKeys "^({v})", True

On Error GoTo 0
Set outMail = Nothing
Set OutApp = Nothing

End Sub
 
Last edited by a moderator:

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
This is an example macro from my library ...

VBA Code:
Option Explicit


Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp, OutMail As Object
Dim FullIdNo As String
Dim strFilename As String

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With

Sheets(1).Select
lRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lRow

     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)

        toList = Cells(i, 2)    'gets the recipient email address from col X
        eSubject = "This is your Subject"
        eBody = "Dear " & Cells(i, 1) & vbCrLf & vbCrLf & "Just a quick note to advise your VIP Client's status at the show." & vbCrLf & vbCrLf & vbCrLf & _
        "Sincerely, " & vbCrLf & vbCrLf & _
        "John Doe "
        
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = ""
        .BCC = ""
        .Subject = eSubject
        .Body = eBody
        .Display   ' ********* Creates draft emails. Comment this out when you are ready
        '.Send     '********** UN-comment this when you  are ready to go live
        End With
        
        
    Application.Goto ActiveWorkbook.Sheets("Sheet1").Range("A1")

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 
Next i

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
End Sub
 
Upvote 0
This is an example macro from my library ...

VBA Code:
Option Explicit


Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp, OutMail As Object
Dim FullIdNo As String
Dim strFilename As String

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With

Sheets(1).Select
lRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lRow

     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)

        toList = Cells(i, 2)    'gets the recipient email address from col X
        eSubject = "This is your Subject"
        eBody = "Dear " & Cells(i, 1) & vbCrLf & vbCrLf & "Just a quick note to advise your VIP Client's status at the show." & vbCrLf & vbCrLf & vbCrLf & _
        "Sincerely, " & vbCrLf & vbCrLf & _
        "John Doe "
       
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = ""
        .BCC = ""
        .Subject = eSubject
        .Body = eBody
        .Display   ' ********* Creates draft emails. Comment this out when you are ready
        '.Send     '********** UN-comment this when you  are ready to go live
        End With
       
       
    Application.Goto ActiveWorkbook.Sheets("Sheet1").Range("A1")

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing

Next i

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
End Sub
Thank you ill see if i can tweak what i have and yours together.
 
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,264
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top