For/Next using to loop table in generated mail

Question

Trying to create code which would take information from list put it into table and create mail which would contain this table. Table has to change for each row, but when i start lets just say for two rows, it will create two mail with same information.

Sub Test()

    Dim OutApp As Object, OutMail As Object

    Dim rng As Range

    Dim strbody As String

    Dim StartRow As Integer, EndRow As Integer

    Dim Email_Send_From, Email_Subject, Email_Send_To, Email_Cc, Email_Bcc, Email_Body, e_mail, m_mail As String

    Dim empid, tname, lob, Loc, sut, aur, ausd, aued, pbt, psp, pst, pd As String

    Dim Mail_Object, Mail_Single As Variant


   Email_Send_From = "main mail"

   StartRow = InputBox("enter number 2.")

   EndRow = InputBox("enter the last record")



   If StartRow > EndRow Then

   Msg = "ERROR" & vbCrLf & "The starting row must be less than the ending row!"

   MsgBox Msg, vbCritical, "Advanced Excel Training"

   End If



   For i = StartRow To EndRow

   'nacteni tabulek

   empid = Sheets("WH1OPS").Cells(i, 1)

   tname = Sheets("WH1OPS").Cells(i, 2)

   lob = Sheets("WH1OPS").Cells(i, 3)

   Loc = Sheets("WH1OPS").Cells(i, 4)

   sut = Sheets("WH1OPS").Cells(i, 5)

   aur = Sheets("WH1OPS").Cells(i, 7)

   ausd = Sheets("WH1OPS").Cells(i, 10)

   aued = Sheets("WH1OPS").Cells(i, 12)



   pbt = Sheets("WH1OPS").Cells(i, 18)

   psp = Sheets("WH1OPS").Cells(i, 19)

   pst = Sheets("WH1OPS").Cells(i, 20)

   pd = Sheets("WH1OPS").Cells(i, 21)



   'vlozeni tabulek

   Sheets("mail").Range("G8") = empid

   Sheets("mail").Range("H8") = tname

   Sheets("mail").Range("I8") = lob

   Sheets("mail").Range("J8") = Loc

   Sheets("mail").Range("K8") = sut

   Sheets("mail").Range("L8") = aur

   Sheets("mail").Range("M8") = ausd

   Sheets("mail").Range("N8") = aued



   Sheets("mail").Range("G11") = pbt

   Sheets("mail").Range("H11") = psp

   Sheets("mail").Range("I11") = pst

   Sheets("mail").Range("J11") = pd



   e_mail = Sheets("WH1OPS").Cells(i, 28)

   m_mail = Sheets("WH1OPS").Cells(i, 6)





   Email_Send_To = e_mail

   Email_Cc = m_mail



   'email text



    Application.ScreenUpdating = False

    Set OutApp = CreateObject("Outlook.Application")

    Set rng = Nothing




    Set rng = Sheets("mail").Range("G7:N11").SpecialCells(xlCellTypeVisible)


   'kterej manager je pouzitej ?? Email_Body = "Dear " & firstName & ","

   Email_Body = Email_Body & "<br>" & "<br>" & "Please note that " & aued & "."

   Email_Body = Email_Body & "<br>" & "<br>" & RangetoHTML(rng)


            Set Mail_Object = CreateObject("Outlook.Application")

            Set Mail_Single = Mail_Object.CreateItem(0)

            With Mail_Single

                .To = Email_Send_To

                .Subject = "Purchase Order Data"

                .HTMLBody = Email_Body

                .Display  'Or use .Send

            End With

debugs:             If Err.Description <> "" Then MsgBox Err.Description



Next i



End Sub



Public Function RangetoHTML(rng As Range)


    Dim fso As Object

    Dim ts As Object

    Dim TempFile As String

    Dim TempWB As Workbook


    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in

    rng.Copy

    Set TempWB = Workbooks.Add(1)

    With TempWB.Sheets(1)

        .Cells(1).PasteSpecial Paste:=8

        .Cells(1).PasteSpecial xlPasteValues, , False, False

        .Cells(1).PasteSpecial xlPasteFormats, , False, False

        .Cells(1).Select

        Application.CutCopyMode = False

        On Error Resume Next

        .DrawingObjects.Visible = True

        .DrawingObjects.Delete

        On Error GoTo 0

    End With

    'Publish the sheet to a htm file

    With TempWB.PublishObjects.Add( _

         SourceType:=xlSourceRange, _

         Filename:=TempFile, _

         Sheet:=TempWB.Sheets(1).Name, _

         Source:=TempWB.Sheets(1).UsedRange.Address, _

         HtmlType:=xlHtmlStatic)

        .Publish (True)

    End With

    'Read all data from the htm file into RangetoHTML

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

    RangetoHTML = ts.readall

    ts.Close

    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _

                          "align=left x:publishsource=")


    'Close TempWB

    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function

    Kill TempFile
End Function 

Answer 1

You never reset Email_Body's value.

  'kterej manager je pouzitej ?? Email_Body = "Dear " & firstName & ","
   Email_Body = ""
   Email_Body = Email_Body & "<br>" & "<br>" & "Please note that " & aued & "."