在邮件正文中插入文本，超链接和表格

我正试图在邮件正文中插入文本，超链接和表格。

Sub Sendmail() Dim olItem As Outlook.MailItem Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSht As Excel.Worksheet Dim sPath As String Dim iRow As Long Dim strRFIitems As String Dim Signature As String sPath = "**" ' // Excel Set xlApp = CreateObject("Excel.Application") ' // Workbook Set xlBook = xlApp.Workbooks.Open(sPath) ' // Sheet Set xlSht = xlBook.Sheets("Sheet1") ' // Create e-mail Item Set olItem = Application.CreateItem(olMailItem) trRFIitems = xlSht.Range("E2") Signature = xlSht.Range("F2") With olItem .To = Join(xlApp.Transpose(xlSht.Range("A2", xlSht.Range("A9999").End(xlUp))), ";") .CC = Join(xlApp.Transpose(xlSht.Range("B2", xlSht.Range("B9999").End(xlUp))), ";") .Subject = xlSht.Range("C2") .Body = xlSht.Range("D2") & Signature .Attachments.Add (strRFIitems) .Display End With ' // Close xlBook.Close SaveChanges:=True ' // Quit xlApp.Quit Set xlApp = Nothing Set xlBook = Nothing Set xlSht = Nothing Set olItem = Nothing End Sub 

此代码从链接的Excel工作表中检索数据并发送邮件。

要求是：

从链接的Excel工作表中检索收件人，抄送，正文，主题和签名数据。

预期的结果：

请注意，这是预期的格式。

预期的邮件正文包含超链接和一个表。

注意：我需要从Excel中获取值，因为表中的值不断变化。

Answer 1

请试试这个

 Sub testEmail() ' these constants are necessary when using "late binding" ' determined by using "early binding" during initial development Const wdTextureNone = 0 Const wdColorAutomatic = &HFF000000 ' -16777216 Const wdWord9TableBehavior = 1 Const wdAlignParagraphCenter = 1 Const wdAutoFitContent = 1 Const wdAutoFitWindow = 2 Const wdAutoFitFixed = 0 Dim outMail As Outlook.MailItem Set outMail = Application.CreateItem(olMailItem) ' 0 outMail.Display (False) ' modeless ' Dim wd As word.Documents ' early binding ... requires reference to "microsoft word object library" Dim wd As Object ' late binding ... no reference required Set wd = outMail.GetInspector.WordEditor wd.Paragraphs.Space2 ' double spaced wd.Paragraphs.SpaceAfter = 3 wd.Paragraphs.SpaceBefore = 1 wd.Range.InsertAfter "Hi Team!" & vbCrLf wd.Range.InsertAfter "Please update the portal with the latest information." & vbCrLf wd.Range.InsertAfter "The portal link:" & vbCrLf ' wd.Words(wd.Words.Count).Select ' debug wd.Hyperlinks.Add Anchor:=wd.Words(wd.Words.Count), _ Address:="http://google.com", SubAddress:="", _ ScreenTip:="this is a screen ttip", TextToDisplay:="link text to display" wd.Range.InsertAfter vbCrLf ' wd.Words(wd.Words.Count).Select ' debug wd.Range.InsertAfter "The team details are mentioned below:" & vbCrLf wd.Tables.Add Range:=wd.Words(wd.Words.Count), NumRows:=3, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed ' 1,0 ' Dim tabl As word.Table ' early binding ... requires reference to "microsoft word object library" Dim tabl As Object ' late binding ... no reference required Set tabl = wd.Tables(1) tabl.Cell(1, 1).Range.Text = "Team" tabl.Cell(1, 2).Range.Text = "Head" tabl.Cell(2, 1).Range.Text = "litmus" tabl.Cell(2, 2).Range.Text = "Sam" tabl.Cell(3, 1).Range.Text = "sigma" tabl.Cell(3, 2).Range.Text = "tony" wd.Range.InsertAfter vbCrLf & "regards" & vbCrLf ' -------------------------------------------------------------------- ' configure the table ' -------------------------------------------------------------------- ' wd.Tables(1).Columns(1).Cells(1).Select ' debug ' wd.Tables(1).Columns(1).Cells(2).Select ' wd.Tables(1).Columns(1).Cells(3).Select tabl.Style = "Table Grid" tabl.ApplyStyleHeadingRows = True tabl.ApplyStyleLastRow = False tabl.ApplyStyleFirstColumn = True tabl.ApplyStyleLastColumn = False tabl.ApplyStyleRowBands = True tabl.ApplyStyleColumnBands = False tabl.Shading.Texture = wdTextureNone ' 0 tabl.Shading.ForegroundPatternColor = wdColorAutomatic ' -16777216 (hex: &HFF000000) tabl.Shading.BackgroundPatternColor = wdColorAutomatic tabl.Rows(1).Shading.BackgroundPatternColor = RGB(200, 250, 200) ' table header colour ' tabl.Shading.BackgroundPatternColor = wdColorRed ' tabl.Range.Select ' debug tabl.Range.Paragraphs.Space1 ' single spaced tabl.Range.Paragraphs.SpaceAfter = 0 tabl.Range.Paragraphs.SpaceBefore = 0 tabl.Range.Font.Size = 14 tabl.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter ' 1 tabl.Rows(1).Range.Font.Size = 18 tabl.Rows(1).Range.Bold = True ' tabl.AutoFitBehavior (wdAutoFitContent) ' 1 ' tabl.AutoFitBehavior (wdAutoFitWindow) ' 2 tabl.AutoFitBehavior (wdAutoFitFixed) ' 0 tabl.Columns(1).Width = 100 tabl.Columns(2).Width = 100 Set tabl = Nothing Set wd = Nothing Set outMail = Nothing End Sub