macro in excel to forward an email.

[Latha]

Team,

the below code I have send emails to the list of addresses provided in Sheet1!A column.

but i would like this macro to forward a specific email to the list of recipients in Sheet1!A column.

Please help me.

Please note that the email to be forwarded contains some embedded picture also.

Sub Send_Mail_Click()
    Dim olapp As Outlook.Application
    Dim olmail As Outlook.MailItem
    Dim rng1 As Range
    Dim rng2 As Range
    Dim StrBody1 As String
    Dim StrBody2 As String
    Dim StrBody3 As String
    Dim LResult As String
    Dim i As Long
    Dim SigString As String
    Dim Signature As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim sh As Worksheet
    Dim TheActiveWindow As Window
    Dim TempWindow As Window

    Application.EnableCancelKey = xlDisabled
                
        For i = 2 To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
                          
                Set olapp = New Outlook.Application
                Set olmail = olapp.CreateItem(olMailItem)
        
                              
                SigString = Environ("appdata") & _
                        "\Microsoft\Signatures\Sunil_sig.htm"
            
                If Dir(SigString) <> "" Then
                    Signature = GetBoiler(SigString)
                Else
                    Signature = ""
                End If
        
                On Error Resume Next
                With olmail
                    .To = Cells(i, 2).Value
                    .CC = "Vikram.Poovanna@xxxx.com;" & "Sunil.Kumar2@xxxx.com;" & "Gaurav.Kansal@xxxx.com"
                    .Subject = "XXXXXXXXX<" & Cells(i, 3).Value & ">"
                    
                    'Set body format to HTML
                    
                     StrBody1 = "<P STYLE='font-family:Trebuchet MS (10) ;font-size:13'>Hi  " & Sheets("Sheet1").Cells(i, 2).Value & "<p>" & _
                    "<P STYLE='font-family:Trebuchet MS (10) ;font-size:13'>Please find the details of tickets and the ageing as "
                    
                    StrBody2 = Format(Now, "dd.mmm.yyyy") & " for the resolver group you own. We seek your support to reduce this to zero tickets over 10 days, and help to not beach SLA for any ticket. Providing this level of service, you will agree, will improve customer satisfaction and end user delight." & "<br><br>" & _
                    "<P STYLE='font-family:Trebuchet MS (10) ;font-size:13'>Please Note : Service desk will send this report to all of you for the next 2 weeks to enable you to track your progress.  If you need our assistance, please do let us know." & "<p>"
        
                    StrBody3 = "<P STYLE='font-family:Trebuchet MS (10) ;font-size:13'> If there would be any feedback or suggestion please write to "

                    .HTMLBody = StrBody1 & StrBody2 & StrBody3 & "<a href=""mailto:Sunil.Kumar2@xxxx.com"">sunil.kumar2@xxxx.com" & "<br>" & Signature
                    '.Attachments.Add TempFilePath & TempFileName & FileExtStr
    
                    .Send
                    
                End With
                 On Error GoTo 0
                               
    Next
        ThisWorkbook.Save
'End With
End Sub


Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function