• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to send email having body message copied from excel

Manish2007

New Member
Dear Members,

Could you please help me to write a VBA code which includes data to be copied from one excel sheet (Reporting) having filter for a specific value taken from another sheet (Email Owners) into outlook email body and then perform the same action till my other sheet (Email Owners) list is complete.

Email owner shet;

Reporting Sheet

Field1AccountSum_Rpt CCY Bal YTD
75041001211482393
75042030705101-245
750420312393340
75042031239382-2,809,158
75042031981075-156,020
76012031238387-908,380
76014722701613-764
76014722708440-5,965
76472031258677-2,094,476
7647203195865326
76472032106225-2
764721938299866,444
76474722720867-15
76474722781573-371
764747239000020
764758517000027
76501001206528421
 

RDAngelo

Member
Assumes the following:
  • Sheet1 contains email addresses
  • Sheet2 contains reporting data
  • Data on both worksheets begins at A1
  • Data on both worksheets have header rows
  • MS Outlook is up and running
  • Code copied into standard module
Code:
Option Explicit
Sub Filter_Data_and_Send_Email()
    Dim rg As Range, i As Long
    Dim fltr As Range, oDoc As Object

    Set rg = Sheet1.Cells(1, 1).CurrentRegion
    Set fltr = Sheet2.Cells(1, 1).CurrentRegion
    
    For i = 2 To rg.Rows.Count
        fltr.AutoFilter 1, rg(i, 1).Value2
        With CreateObject("Outlook.Application").CreateItem(0)
            .Display
            .To = rg(i, 2).Value2
            .Subject = "Report"
            Set oDoc = .GetInspector.WordEditor
            fltr.SpecialCells(xlCellTypeVisible).Copy
            oDoc.Range(0, 0).Paste
            '.Send
        End With
    Next i
End Sub
 

Attachments

Manish2007

New Member
Hi RDAngelo,

Thank you for the above code, this really looks promising. But the problem here i am facing is my email already a a couple of lines that are to be published before i copy the data from the sheets. below is the code which i have, but i failed to compile the above one with below.. please help as i am pretty new to VBA..

Please help.

>>> use code - tags <<<
Code:
Sub mail()
Dim ol As New Outlook.Application
Dim olMail As Outlook.MailItem
Dim i As Integer
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
   
Set olMail = ol.CreateItem(olMailItem)
With olMail
.To = Range("B" & i).Value
.CC = "Manish@gmail.com;manish@gmail.com"
.Subject = "Current Breaks with IC for Code " & Range("A" & i).Value
.Body = "Hi There ," & Chr(10) & Chr(10) & "Based on the current day IC balance report for Code #" & Range("A" & i).Value & "  and below highlighted are beyond the threshold criteria i.e. $1K." & Chr(10) & Chr(10) & "Please have a look and help clear the below accounts." & Chr(10) & Chr(10) & "Thanks & Regards" & Chr(10) & "Manish "
'''''''''''This is where i want the above filtered/copied data to be pasted and reported'''''''''''''''''''''
.Send
Range("C" & i).Value = "Sent"
End With
Next i
MsgBox "Controllers Notified !!"

End Sub
 
Last edited by a moderator:

RDAngelo

Member
Try this version...
Code:
Option Explicit
Sub Filter_Data_and_Send_Email_v2()
    Dim rg As Range, i As Long
    Dim fltr As Range, oDoc As Object
    Dim sBody As String

    Set rg = Sheet1.Cells(1, 1).CurrentRegion
    Set fltr = Sheet2.Cells(1, 1).CurrentRegion
    
    sBody = "Hi There ," & Chr(10) & Chr(10) & "Based on the current day IC balance report for Code #" & Range("A" & i).Value & " and below highlighted are beyond the threshold criteria i.e. $1K." & Chr(10) & Chr(10) & "Please have a look and help clear the below accounts." & Chr(10) & Chr(10) & "Thanks & Regards" & Chr(10) & "Manish "
    
    For i = 2 To rg.Rows.Count
        fltr.AutoFilter 1, rg(i, 1).Value2
        fltr.SpecialCells(xlCellTypeVisible).Copy
        With CreateObject("Outlook.Application").CreateItem(0)
            .Display
            .To = rg(i, 2).Value2
            .Subject = "Report"
            .body = sBody
            Set oDoc = .GetInspector.WordEditor
            With oDoc
                .Range(.Range.End - 1, .Range.End - 1).Paste
            End With
            '.Send
        End With
        Sheet1.Cells(i, 3).Value = "Sent"
    Next i
    MsgBox "Controllers Notified !!"
End Sub
 
Top