excel VBA MAIL群發問題

chu0077

不好意思 我是一个VBA初學者.想請教一下

我想在EXCEL VBA設一个MAIL群發公式.但我目前僅能做到在一個儲存格裡發送一份MAIL.無法將一個範圍內的多位收件者.一起群發.我想要將B2~B5的收件者都一起寄出.但目前一直做不到

以下是我的程式碼.
Sub sendmail()
Dim objEmail As Object
Const SMTPSERVER = "msa.hinet.net" '使用 msa.hinet.net 传送邮件

Set objEmail = CreateObject("CDO.Message") '建立 CDO 物件
With objEmail.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPSERVER
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With

objEmail.From = "quni_lin@yungtech.com" '寄件者（网域必须存在）
objEmail.To = Range("B2").Value '收件者
objEmail.Subject = Range("E2").Value '邮件主旨
objEmail.HTMLBody = Range("F2").Value 'HTML邮件内文
objEmail.Send
Set objEmail = Nothing
End Sub

請問以上該如何修改  

感謝各位高手

chu0077

回復 3# ikboy


    大大  您的方法有用   太好了  非常感激您

:D

ikboy

Sub sendmail()
Dim objEmail As Object
Const SMTPSERVER = "msa.hinet.net" '使用 msa.hinet.net 传送邮件

Set objEmail = CreateObject("CDO.Message") '建立 CDO 物件
With objEmail.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPSERVER
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With


Dim arr  '假設您將[B2]往下作為收件人可來個動態一點:
arr = Range("b2:b" & [a65536].End(3).Row)
For i = 1 To UBound(arr)
    recipients = recipients & arr(i, 1)
Next

objEmail.From = "quni_lin@yungtech.com" '寄件者（网域必须存在）
objEmail.To = Mid(recipients, 2) '收件群
objEmail.Subject = Range("E2").Value '邮件主旨
objEmail.HTMLBody = Range("F2").Value 'HTML邮件内文
objEmail.Send
Set objEmail = Nothing
End Sub

ikboy

Sorry,  漏了 join(Array....., "; ")

ikboy

objEmail.To = array([b2],[b3],[b4],[b5])