Mail body table format from sheet

elsuji · Sep 11th 2021

Dear Team,

I created code for sending mail based on value matched. I want to insert the data to the mail body in table format from the sheet.

In column BP if it is in service then the contents to be copied from columns C, I & BQ

and the body format is

Dear Service Team,

Please take care of the below list,

Customer Name	Office address	Support required
M/S ACC Ltd	Magadi Road	The customer has requested to share the Spares catalogue/Electrical Drawing of the M1CR batching plant.
M/s Vavedha Infra	office address	support required
M/s Ramalingm Construction	office address	support required
M/s ZIRCON RMC	Bangalore	The customer has requested to share the Spares catalogue/Electrical Drawing of the M1CR batching plant.

and another mail to be triggered for the Spares team

Dear Spares Team,

Please take care of the below list,

Customer Name	Office address	Support required
M/s Panchami Concrete	office address	support required
M/s HI Tech RMC	office address	support required
M/s CCCL Infra	office address	support required

And also another mail to be triggered for Units Team

Dear Units Team,

Please take care of the below list,

Customer Name	Office address	Support required
M/S Shree Concrete	Magadi Road	The customer has requested to share the Spares catalogue/Electrical Drawing of the M1CR batching plant.
M/s Tulasi concrete	office address	support required

My code is

Code

Sub Grievances_Mail()
    Dim olApp As Object
    Dim olMail As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object
    Dim sPath As String
    Dim sMessage As String
    Dim sFile As String
    Dim cell As Range
    Dim sBCC As String
    Dim sh As Worksheet
    
    
    Set sh = ThisWorkbook.Sheets("Weekly Visit report")
        For Each cell In sh.Columns("BP").Cells.SpecialCells(xlCellTypeConstants)
            If cell.Value Like "Service" Then
                sMessage = "<br>" & "<font size=""3"" face=""Cambria"" color=""Blue"">" & "Dear Service Team, <br><br>" _
                & "Please take care of the below list, <br><br>" _
                & cell.Offset(, -65).Value & "  " & cell.Offset(, -59).Value & "  " & cell.Offset(, 1).Value
            End If
        Next cell
 
    Set olApp = CreateObject("Outlook.Application")


 
    On Error Resume Next
    Set olMail = olApp.CreateItem(0)
        With olMail
            .BCC = sBCC
            .Subject = "GREETINGS FROM SCHWING STETTER!!!"
            .HTMLBody = sMessage
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor 'access the message body for editing
            .Display 'required to edit message body
        End With

    Set olApp = Nothing
    Set olMail = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
 
End Sub

Display More

Can anyone help me with how to do the above y requirements? My file is attached here for your kind reference

**royUK** · Sep 12th 2021

That table will not fit an email body.

elsuji · Sep 12th 2021

Is there any other way for this. Pls help me

elsuji · Sep 12th 2021

Dear Ray,

I changed the code and now my mail body is like this

Dear Service Team,

Please take care of the below list,

Customer Name : M/s ZERCON RMC
Location : Bangalore
Support required : Customer has requested to share the Spares catalogue/Electrical Drawing of M1CR batching plant.

Code is

Code

Sub Grievances_Mail()
    Dim olApp As Object
    Dim olMail As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object
    Dim sPath As String
    Dim sMessage As String
    Dim sFile As String
    Dim cell As Range
    Dim sBCC As String
    Dim sh As Worksheet
    
    
    Set sh = ThisWorkbook.Sheets("Weekly Visit report")
        For Each cell In sh.Columns("BP").Cells.SpecialCells(xlCellTypeConstants)
            If cell.Value Like "Service" Then
                sMessage = "<br>" & "<font size=""3"" face=""Cambria"" color=""Blue"">" & "Dear Service Team, <br><br>" _
                & "Please take care of the below list, <br><br>" _
                & "Customer Name : " & cell.Offset(, -65).Value & "<br>" _
                & "Location : " & cell.Offset(, -59).Value & "<br>" _
                & "Support required : " & cell.Offset(, 1).Value
            End If
        Next cell
 
    Set olApp = CreateObject("Outlook.Application")


 
    On Error Resume Next
    Set olMail = olApp.CreateItem(0)
        With olMail
'            .BCC = sBCC
            .Subject = "GREETINGS FROM SCHWING STETTER!!!"
            .HTMLBody = sMessage
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor 'access the message body for editing
            .Display 'required to edit message body
        End With

    Set olApp = Nothing
    Set olMail = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
 
End Sub

Display More

But it is updating only one row. I want to update all the row details where the service is in BP column.

Can you help me

elsuji · Sep 13th 2021

Dear Roy,

I changed the body format from table to list and my new code is

Code

Sub Grievances_Mail()
    Dim olApp As Object
    Dim olMail As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object
    Dim sPath As String
    Dim sMessage As String
    Dim sbody As String
    Dim sFile As String
    Dim cell As Range
    Dim sBCC As String
    Dim sh As Worksheet
    Dim rngA As Range
   
    
     Set sh = ThisWorkbook.Sheets("Weekly Visit report")
        For Each cell In sh.Columns("BP").Cells.SpecialCells(xlCellTypeConstants)
            If cell.Value Like "Service" Then
                sMessage = sMessage & "<br><br>" _
                & "Customer Name : " & cell.Offset(, -65).Value & "<br>" _
                & "Location : " & cell.Offset(, -59).Value & "<br>" _
                & "Contact No : " & cell.Offset(, -60).Value & "<br>" _
                & "Support required : " & cell.Offset(, 1).Value
            End If
            sbody = "<font size=""3"" face=""Cambria"" color=""Blue"">" & "Dear Team, <br><br>" _
                & "Please take care of the below customers problem," & sMessage
        Next cell
        



 
    Set olApp = CreateObject("Outlook.Application")


 
    On Error Resume Next
    Set olMail = olApp.CreateItem(0)
        With olMail
'            .BCC = sBCC
            .Subject = "GREETINGS FROM SCHWING STETTER!!!"
            .HTMLBody = sbody
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor 'access the message body for editing
            .Display 'required to edit message body
        End With

    Set olApp = Nothing
    Set olMail = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
 
End Sub

Display More

My mail body looks

Dear Team,

Please take care of the below customers problem,

Customer Name : M/S ACC Ltd
Location : Magadi Road
Contact No : 8884433993
Support required : Customer has requested to share the Spares catalogue/Electrical Drawing of M1CR batching plant.

Customer Name : M/s Vavedha Infra
Location : office address
Contact No : 23781623
Support required : support required

Customer Name : M/s Ramalingm Construction
Location : office address
Contact No : 23781623
Support required : support required

Customer Name : M/s ZERCON RMC
Location : Bangalore
Contact No : 8884433993
Support required : Customer has requested to share the Spares catalogue/Electrical Drawing of M1CR batching plant.

Now the problem is the body content is updating only for service.

But I want to generate separate mail for another department also.

Can you please help me trigger multiple mails for different branch

elsuji · Sep 16th 2021

Dear Team,

Need your help to resolve my problem

Mail body table format from sheet

Participate now!

Share