How to VBA MAilto all emails in a colum

Question

嗨，我有我的所有客户的电子邮件地址在行A在我的excel工作表命名为“电子邮件”。我已经创建了下面的代码，这样当我在工作表上按下底部时就会弹出一个框，我可以键入主题和一些正文行。我希望能够向我的所有客户发送相同的消息。比如为了升职，或者我们不得不突然关闭办公室等等。有谁能帮帮忙吗？

Private Sub CommandButtonSend_Click()


Dim Email_Subject, Email_Send_From, Email_Body1, Email_Body2, Email_Sig,         Email_Twitter As String
Dim Mail_Object, Mail_Single As Variant

Dim emailrange As Range, cell As Range

Dim Email_Send_To As String


Set emailrange = Worksheets("Email").Range("A2:A4")

For Each cell In emailrange
Email_Send_To = Email_Send_To & "j" & cell.Value
Next
Email_Send_To = Mid(Email_Send_To, 2)
 On Error Resume Next

Email_Subject = UserFormTemplate.TextBoxSubject.Text


Email_Send_From = "shaunha@coversure.co.uk"


Email_Body1 = UserFormTemplate.TextBoxLine1.Text
Email_Body2 = UserFormTemplate.TextBoxLine2.Text

Email_Sig = UserFormTemplate.TextBoxSig.Text

Email_Twitter = UserFormTemplate.TextBoxTwitter.Text



On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.cc = Email_Cc
.BCC = Email_Bcc
.Body = Email_Body1 & vbNewLine & Email_Body2 & vbNewLine & vbNewLine &     "Shaun Harrison  Insurance Consultant" & vbNewLine & "Tel: 0800 308 1022 /  shaunha@coversure.co.uk" & vbNewLine & vbNewLine & Email_Twitter
.send
End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End
End Sub

Answer 1

Sub SendySend()

With ActiveSheet
    EndRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

RowCount = 4

For XCount = 4 To EndRow

 Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.application")
Dim olmail As Outlook.MailItem
Set olmail = olApp.CreateItem(olMailItem)
    If Range("D" & RowCount).Value = "Yes" Then
        olmail.To = Range("A" & RowCount).Value
        olmail.Subject = Range("B" & RowCount).Value
        olmail.Body = Range("C" & RowCount).Value
        olmail.Send
    Else
        DontSend = 1 'This Doesn't do anything at all, it's just for clarity
    End If


RowCount = RowCount + 1

Next

End Sub