For/Next用於在生成的郵件中循環表

Question

嘗試創建將從列表中獲取信息的代碼將其放入表中並創建將包含此表的郵件。 表必須改變每一行，但是當我開始讓我們只說兩行時，它會創建兩個具有相同信息的郵件。

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

您永遠不會重置Email_Body's值。

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