Как отправить определенные c строк через Outlook, используя VBA, если определенные критерии выполнены?

Question

На изображении ниже, если столбец G имеет значение «требуемый», эти строки будут выделены и вставлены в тело внешнего вида. Я хочу точно такую ​​же строку с таким же дизайном.

Я использую приведенный ниже код и закрываю Outlook после выполнения один раз.

Sub esendtable()


Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object

Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)

With newEmail
    .To = "writingearth@gmail.com"
    .CC = ""
    .BCC = ""
    .Subject = Sheet1.Range("G1").Text
    .Body = "Please find the requested information" & vbCrLf & "Best Regards"
    .display

    Set xInspect = newEmail.GetInspector
    Set pageEditor = xInspect.WordEditor
    a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
   For i = 2 To a

    If Worksheets("Sheet1").Cells(i, 7).Value = "Required" Then
    Worksheets("Sheet1").Rows(i).Copy
    End If
      Next
    pageEditor.Application.Selection.Start = Len(.Body)
    pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
    pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)
    .display
    .Send

    Set pageEditor = Nothing
    Set xInspect = Nothing
End With
Set newEmail = Nothing
Set outlook = Nothing

End Sub

Я также использовал приведенный ниже код, но показывает ошибку автоматизации и удаленную процедуру сбой вызова.

  Sub Send_email_fromexcel()
    Dim edress As String
    Dim subj As String
    Dim message As String
    Dim outlookapp As Object
    Dim outlookmailitem As Object
    Dim path As String
    Dim lastrow As Integer
    Dim i As Integer
    Dim header1 As String
    Dim header2 As String
    Dim header3 As String
    Dim header4 As String
    Dim header5 As String
    Dim header6 As String
    Dim header7 As String
    Dim data1 As String
    Dim data2 As String
    Dim data3 As String
    Dim data4 As String
    Dim data5 As String
    Dim data6 As String
    Dim data7 As String
    a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To a
    If Worksheets("Sheet1").Cells(i, 7).Value = "Required" Then
       Worksheets("Sheet1").Rows(i).Copy
        Set outlookapp = CreateObject("Outlook.Application")
        Set outlookmailitem = outlookapp.CreateItem(0)
    '    header = Worksheets("Sheet1").Rows(i).Copy
        edress = "writingearth@gmail.com"
    subj = Sheet1.Cells(1, 7)
          header1 = Sheet1.Cells(1, 1)
          header2 = Sheet1.Cells(1, 2)
          header3 = Sheet1.Cells(1, 3)
         header4 = Sheet1.Cells(1, 4)
          header5 = Sheet1.Cells(1, 5)
          header6 = Sheet1.Cells(1, 6)
          header7 = Sheet1.Cells(1, 7)
        data1 = Sheet1.Cells(i, 1)
        data2 = Sheet1.Cells(i, 2)
        data3 = Sheet1.Cells(i, 3)
        data4 = Sheet1.Cells(i, 4)
        data5 = Sheet1.Cells(i, 5)
        data6 = Sheet1.Cells(i, 6)
        data7 = Sheet1.Cells(i, 7)


            outlookmailitem.To = edress
            outlookmailitem.CC = ""
            outlookmailitem.BCC = ""
            outlookmailitem.Subject = subj
            outlookmailitem.Body = "Please find the requested information" & vbCrLf & header1 & "  " & header2 & " " & header3 & "   " & header4 & "   " & header5 & "   " & header6 & "  " & header7 & _
             vbCrLf & data1 & "    " & data2 & "        " & data3 & "        " & data4 & "        " & data5 & "        " & data6 & "    " & data7 & _
            vbCrLf & "Best Regards"


            outlookmailitem.Display
            outlookmailitem.send
      End If
    Next i

    Set outlookapp = Nothing
    Set outlookmailitem = Nothing

    End Sub