Excel 将电子邮件列表复制到Outlook

有人能帮我写下面的代码吗？下面是一段代码，用于将电子邮件id列表从Sheet1单元格B2复制到具有数据的n行

我在这方面面临两个问题

1 HTMLBody文本未复制到电子邮件。 2第1页、B2页及以后的电子邮件收件人列表未复制到电子邮件收件人列表中

提前谢谢

Sub MeetingMacro()
'MsgBox Hour(Now)
If Weekday(Now, vbMonday) >= 6 And Hour(Now) > 12 Then
Exit Sub
End If

Application.ScreenUpdating = False

Dim pt As PivotTable
Set pt = ThisWorkbook.Sheets("Sheet2").PivotTables("PivotTable")
pt.RefreshTable
Application.CalculateUntilAsyncQueriesDone
Call saveAsXlsx1
Application.CalculateUntilAsyncQueriesDone
Call savefile
Application.CalculateUntilAsyncQueriesDone
Call Send_Range
'Call Send_Range


End Sub

Sub Send_Range()

   Dim TBL As ListObject
     ThisWorkbook.Activate

   ThisWorkbook.EnvelopeVisible = False
   ThisWorkbook.Sheets("Sheet2").Range("A1:B30").Select
    ThisWorkbook.Activate
   With ActiveSheet.MailEnvelope

            SDest = ""
       For iCounter = 2 To WorksheetFunction.CountA(Columns(3))
           If SDest = "" Then
               SDest = Cells(iCounter, 3).Value
               SDest.Value.Select
           Else
               SDest = SDest & ";" & Cells(iCounter, 3).Value
           End If
       Next iCounter

      .Item.To = SDest
      .Item.CC = "someone@example.com"
      .Item.Subject = "[URGENT] Meeting has been cancelled. "
      .Item.HTMLBody = "Hello," & vbCrLf & "Meeting has been cancelled. Fresh invite will be sent soon.” & vbCrLf & "Regards"
      .Item.Attachments.Add "C:\Attachment.xlsx" 'ActiveWorkbook.FullName
      .Item.Send
   End With

   'MsgBox (TimeOfDay)
End Sub


'MsgBox (TimeOfDay)
Sub savefile()
 Application.ScreenUpdating = False
     ThisWorkbook.Activate
     Application.ScreenUpdating = True
ThisWorkbook.Save
End Sub
Sub saveAsXlsx1()
ThisWorkbook.Worksheets(Array("Sheet2")).Copy
Application.DisplayAlerts = False
 ActiveSheet.Shapes.Range("FetchData").Delete
ActiveWorkbook.SaveAs Filename:="C:\Attachment.xlsx"
ActiveWorkbook.Close
End Sub

Sub Meeting4()
ThisWorkbook.Application.DisplayAlerts = False
ActiveWorkbook.Save
ThisWorkbook.Close
End Sub

---

假设您在Sheet1的同一列中有B2:B30单元格，包含电子邮件地址。您要做的是获取这些单元格中的值，并将它们转换为一维数组-如下所示：

Dim values As Variant
values = Application.WorksheetFunction.Transpose(Sheet1.Range("B2:B30").Value)

对于一维电子邮件地址数组，您只需将其转换为字符串。Join函数正是为此而设计的：

Dim recipients As String
recipients = Join(values, ";")

就这些。。。假设所有单元格都包含电子邮件地址字符串。如果一个单元格包含错误值，则可能出现问题。如果有空白，期待空白不应该有什么区别。如果要抓取的范围不是刻在石头上，研究如何使其更具活力

---

HtmlBody需要一个包含HTML标记的HTML编码字符串。如果只有纯文本，请使用Body属性。

据我所知，HTMLBody期望的是HTML。SDest是什么类型？如果没有声明，那么SDest=将其变为变量/字符串，然后SDest=单元格…值使其成为该单元格值的任何类型，然后SDest.Value.Select肯定会爆炸-删除该指令，您不需要选择任何内容。我有另一个可行的解决方案，但您的反馈也很有用。非常感谢。