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 & "."

For / Next用于在生成的邮件中循环表

1 个答案: