Extract Two Rows from a Range and send Mail

[Ranadeep]

Hi,

I have a table range, i would like to extract two rows from the range and send mail. Also i need to keep the column header same. I tried using the following
DatatoSend = Union(.Range(.Cells(1, "A"), .Cells(1, "B")), _
.Range(.Cells(c.Row, "A"), .Cells(c.Row , "B")))
But it Picks up one Row Item along with the header column, i want to pick two row items at a time and send mail, so if there are 4 row items. Two mails should go with 1st row header and subsequent rows A1,B1;A2,B2;A3,B4 should be items for first mail and second mail should have A1,B1;A4,B4

Can someone help please... here is the code I am using

Sub SendEmail()

    Dim objOutlook As Object
    Dim objNameSpace As Object
    Dim objMailItem As Object
    Dim ws As Worksheet
    Dim rngEmailAddress As Range
    Dim c As Range
    Dim rngAttach As Range
    Dim strBody As String
    Dim strAttachment As String
  
    Set ws = Sheets("Test Mail")   'Edit the sheet name if required.
  
    With ws
       Set rngEmailAddress = .Range(.Cells(2, "B"), .Cells(.Rows.Count, "B").End(xlUp))
    End With
   
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
  
    If objOutlook Is Nothing Then
        Set objOutlook = CreateObject("Outlook.Application")
    End If
  
    Set objNameSpace = objOutlook.GetNamespace("MAPI")
  
    strBody = "<p style='font-family:Calibri;font-size:16'>Dear Team, " & "<br><br>" & _
    "<p style='font-family:Calibri;font-size:16'>Please log a ticket for backup failure for the following devices, details as on " & Format(Date, "dd-mm-yyyy")

          
    For Each c In rngEmailAddress
  
        With ws
            Set rngAttach = Union(.Range(.Cells(1, "A"), .Cells(1, "B")), _
                        .Range(.Cells(c.Row, "A"), .Cells(c.Row + 1, "B")))
        End With
      
        Set objMailItem = objOutlook.CreateItem(0)
         
        With objMailItem
            .To = "email id 1"c.Value
            .Subject = "Testing Mail Sending"    
            .HTMLBody = strBody & RangetoHTML(rngAttach) & "<br>" & .HTMLBody
            .Send      
        End With
       
        DoEvents
      
    Next c
    
    Set c = Nothing
    Set rngEmailAddress = Nothing
    Set ws = Nothing
    Set objMailItem = Nothing
    Set objNameSpace = Nothing
    Set objOutlook = Nothing
End Sub

 

[Aby]

share the file instead to have a look , else we need to recreate it all and time is a constraint

 

[Ranadeep]

share the file instead to have a look , else we need to recreate it all and time is a constraint

Hi Aby,

Thanks for the response, please find the file attached

 

[Deepak]

Hi,

First, Always use code tags while pasting codes in the body {I did in this case} !!

& About the subjected query!!

Changing these might resolve your issue.

CompleteRange = .Cells(.Rows.Count, "B").End(xlUp).Row

'and

Dim i As Integer       
    For i = 2 To CompleteRange Step 2
'    For Each c In CompleteRange

and

next c to next

 

[Ranadeep]

Hi,

First, Always use code tags while pasting codes in the body {I did in this case} !!

& About the subjected query!!

Changing these might resolve your issue.

CompleteRange = .Cells(.Rows.Count, "B").End(xlUp).Row

'and

Dim i As Integer      
    For i = 2 To CompleteRange Step 2
'    For Each c In CompleteRange

and

next c to next

Hi Deepak,

Thanks for the response, however it didn't work as expected. Well yes it did send two email but the expected data didn't go through. The output which was sent is as follows

Mail 1
Data 1 Data 2
4 4

Mail 2
Data 1 Data 2
4 4

 

[Deepak]

Hi Deepak,

Thanks for the response, however it didn't work as expected. Well yes it did send two email but the expected data didn't go through. The output which was sent is as follows

Mail 1
Data 1 Data 2
4 4

Mail 2
Data 1 Data 2
4 4

Hi,

I tested & find working.

 

[Ranadeep]

Hi,

I tested & find working.

Hi Deepak,

Yes it worked ... Thanks a Lot ....