Question

您好我的所有客户的电子邮件地址在我的Excel工作表的第A行中命名为＆＃34;电子邮件＆＃34;。我已经创建了下面的代码，以便当我按下工作表上的底部时弹出一个框，我可以输入主题和几条生物线。我希望能够向我的所有客户发送相同的消息。 IE用于促销或者我们不得不意外关闭办公室等。有人可以帮忙吗？

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

如何VBA MAilto列中的所有电子邮件

1 个答案: