To: mineshine老师。（Excel自动发邮件延伸问题）

canciaw

你好mineshine老师，同事的要求无止境，可惜我又水平有限，不得不再次请教您。。。

以下代码的邮件正文需要设置成为 Times Roman，14号字，并且在从excel表中选择的各个column用蓝色表示。
我用蓝色标出。

Sub AutoMail()
Dim OutlookApp As Object
Dim MailItem As Object
Dim Recipient As Object
Dim i As Integer
For i = 2 To Sheets("CFD").[A65536].End(xlUp).Row
    Set OutlookApp = CreateObject("Outlook.Application")
    Set MailItem = OutlookApp.CreateItem(0)
    Set Recipient = MailItem.Recipients.Add(Sheets("CFD").Range("U" & i).Value)
    MailItem.Subject = "This is auto Email From Kuehne & Nagel Ltd Guangzhou Office"
    MailItem.Body = "致尊敬的经销商:" & vbNewLine & _
    "Dear Dealer:" & vbNewLine & _
    "                              " & vbNewLine & _
    "                              " & vbNewLine & _
    "xxxxxxx广州分公司，由xxxxxx广州配送中心" & vbNewLine & _
    "委托，承运订单号为 (附件" & Sheets("CFD").Range("A" & i).Value & ")的零部件至（附件" & Sheets("CFD").Range("F" & i).Value & "）。" & vbNewLine & _
    "如需查询该票货物的运输状态，请浏览xxxx司的网页http://www.abc.com/。" & vbNewLine & _
    "您的查询号码为 （附件" & Sheets("CFD").Range("B" & i).Value & "）." & vbNewLine & _
    "                              " & vbNewLine & _
    "KN was authorized by Daimler Northeast Asia Parts Trading and Services Co., LTD" & vbNewLine & _
    "Guangzhou PDC to deliver automotive parts under PO   (" & Sheets("CFD").Range("A" & i).Value & ")   to" & vbNewLine & _
    "(" & Sheets("CFD").Range("F" & i).Value & ")." & vbNewLine & _
    "Regarding the transportation status of mentioned shipment, please check on " & vbNewLine & _
    "KN website http://www.kn-portal.com/. " & vbNewLine & _
    "Your tracking number is  (" & Sheets("CFD").Range("B" & i).Value & ")." & vbNewLine & _
    "                              " & vbNewLine & _
    "                              " & vbNewLine & _
    "谢谢!" & vbNewLine & _
    "Thanks for your attention!" & vbNewLine & _
    "                              " & vbNewLine & _
    "                              " & vbNewLine & _
    "xxxxxxx广州分公司" & vbNewLine & _
    "xxxxxxx Guangzhou Branch Office"
    MailItem.Send
    Set OutlookApp = Nothing
    Set MailItem = Nothing
    Set Recipient = Nothing
Next i
End Sub

好多个谢谢！！！！

mineshine

要配合HTML语法，试看看!!

Sub AutoMail()
Dim OutlookApp As Object
Dim MailItem As Object
Dim Recipient As Object
Dim i As Integer
Dim StrMail As String
For i = 2 To Sheets("CFD").[A65536].End(xlUp).Row
    Set OutlookApp = CreateObject("Outlook.Application")
    Set MailItem = OutlookApp.CreateItem(0)
    Set Recipient = MailItem.Recipients.Add(Sheets("CFD").Range("U" & i).Value)
    MailItem.Subject = "This is auto Email From Kuehne & Nagel Ltd Guangzhou Office"
    StrMail = "<H2>致尊敬的经销商:</H2>" & _
    "<H2>Dear Dealer:</H2><BR><BR>" & _
    "<FONT SIZE=4>xxxxxxx广州分公司，由xxxxxx广州配送中心<BR>" & _
    "委托，承运订单号为 (<Font Face=Times Roman Size=4.5 Color=blue>" & "附件" & Sheets("CFD").Range("A" & i).Value & "</font>)的零部件至（" & "<Font Face=Times Roman Size=4.5 Color=blue>" & "附件" & Sheets("CFD").Range("F" & i).Value & "</font>）。<BR>" & _
    "如需查询该票货物的运输状态，请浏览xxxx司的网页http://www.abc.com/。<BR>" & _
    "您的查询号码为 （" & "<Font Face=Times Roman Size=4.5 Color=blue> " & "附件" & Sheets("CFD").Range("B" & i).Value & "</FONT>）.<BR><BR>" & _
    "KN was authorized by Daimler Northeast Asia Parts Trading and Services Co., LTD<BR>" & _
    "Guangzhou PDC to deliver automotive parts under PO   (<Font Face=Times Roman Size=4.5 Color=blue>" & Sheets("CFD").Range("A" & i).Value & "</FONT>)   to<BR>" & _
    "(<Font Face=Times Roman Size=4.5 Color=blue>" & Sheets("CFD").Range("F" & i).Value & "</FONT>).<BR>" & _
    "Regarding the transportation status of mentioned shipment, please check on <BR>" & _
    "KN website http://www.kn-portal.com/. <BR>" & _
    "Your tracking number is  (<Font Face=Times Roman Size=4.5 Color=blue>" & Sheets("CFD").Range("B" & i).Value & "</FONT>).<BR><BR><BR>" & _
    "谢谢!<BR>" & _
    "Thanks for your attention!<BR><BR><BR>" & _
    "xxxxxxx广州分公司<BR>" & _
    "xxxxxxx Guangzhou Branch Office</FONT>"
    MailItem.HTMLBody = StrMail
    MailItem.Send
    Set OutlookApp = Nothing
    Set MailItem = Nothing
    Set Recipient = Nothing
Next i
End Sub

canciaw

mineshine老师,您的代码可行, 真是让我好佩服!!!!

衷心感谢你!!!

还有一个问题,如何设置Bold格式的呢？：）

mineshine

Sub AutoMail()
Dim OutlookApp As Object
Dim MailItem As Object
Dim Recipient As Object
Dim i As Integer
Dim StrMail As String
For i = 2 To Sheets("CFD").[A65536].End(xlUp).Row
    Set OutlookApp = CreateObject("Outlook.Application")
    Set MailItem = OutlookApp.CreateItem(0)
    Set Recipient = MailItem.Recipients.Add(Sheets("CFD").Range("U" & i).Value)
    MailItem.Subject = "This is auto Email From Kuehne & Nagel Ltd Guangzhou Office"
    StrMail = "<H2>致尊敬的经销商:</H2>" & _
    "<H2>Dear Dealer:</H2><BR><BR>" & _
    "<FONT SIZE=4>xxxxxxx广州分公司，由xxxxxx广州配送中心<BR>" & _
    "委托，承运订单号为 (<Font Face=Times Roman Size=4.5 Color=blue><B>" & "附件" & Sheets("CFD").Range("A" & i).Value & "</B></font>)的零部件至（" & "<Font Face=Times Roman Size=4.5 Color=blue><B>" & "附件" & Sheets("CFD").Range("F" & i).Value & "</B></font>）。<BR>" & _
    "如需查询该票货物的运输状态，请浏览xxxx司的网页http://www.abc.com/。<BR>" & _
    "您的查询号码为 （" & "<Font Face=Times Roman Size=4.5 Color=blue><B> " & "附件" & Sheets("CFD").Range("B" & i).Value & "</B></FONT>）.<BR><BR>" & _
    "KN was authorized by Daimler Northeast Asia Parts Trading and Services Co., LTD<BR>" & _
    "Guangzhou PDC to deliver automotive parts under PO   (<Font Face=Times Roman Size=4.5 Color=blue><B>" & Sheets("CFD").Range("A" & i).Value & "</B></FONT>)   to<BR>" & _
    "(<Font Face=Times Roman Size=4.5 Color=blue><B>" & Sheets("CFD").Range("F" & i).Value & "</B></FONT>).<BR>" & _
    "Regarding the transportation status of mentioned shipment, please check on <BR>" & _
    "KN website http://www.kn-portal.com/. <BR>" & _
    "Your tracking number is  (<Font Face=Times Roman Size=4.5 Color=blue><B>" & Sheets("CFD").Range("B" & i).Value & "</B></FONT>).<BR><BR><BR>" & _
    "谢谢!<BR>" & _
    "Thanks for your attention!<BR><BR><BR>" & _
    "xxxxxxx广州分公司<BR>" & _
    "xxxxxxx Guangzhou Branch Office</FONT>"
    MailItem.HTMLBody = StrMail
    MailItem.Send
    Set OutlookApp = Nothing
    Set MailItem = Nothing
    Set Recipient = Nothing
Next i
End Sub

canciaw

mineshine老师,无言感激!!!!!!

canciaw

mineshine老师,又有问题了...

有没有办法在邮件选取的U栏内输入2个邮件地址，用分号分隔，然后宏会识别这两个邮件地址发2个邮件。或者3个或以上。

mineshine

改一句

Sub AutoMail()
Dim OutlookApp As Object
Dim MailItem As Object
Dim Recipient As Object
Dim i, j As Integer
Dim StrMail As String

For i = 2 To Sheets("CFD").[A65536].End(xlUp).Row
    Set OutlookApp = CreateObject("Outlook.Application")
    Set MailItem = OutlookApp.CreateItem(0)
    'Set Recipient = MailItem.Recipients.Add(Sheets("CFD").Range("U" & i).Value)
    MailItem.To = Sheets("CFD").Range("U" & i).Value
    MailItem.Subject = "This is auto Email From Kuehne & Nagel Ltd Guangzhou Office"
    StrMail = "<H2>致尊敬的经销商:</H2>" & _
    "<H2>Dear Dealer:</H2><BR><BR>" & _
    "<FONT SIZE=4>xxxxxxx广州分公司，由xxxxxx广州配送中心<BR>" & _
    "委托，承运订单号为 (<Font Face=Times Roman Size=4.5 Color=blue><B>" & "附件" & Sheets("CFD").Range("A" & i).Value & "</B></font>)的零部件至（" & "<Font Face=Times Roman Size=4.5 Color=blue><B>" & "附件" & Sheets("CFD").Range("F" & i).Value & "</B></font>）。<BR>" & _
    "如需查询该票货物的运输状态，请浏览xxxx司的网页http://www.abc.com/。<BR>" & _
    "您的查询号码为 （" & "<Font Face=Times Roman Size=4.5 Color=blue><B> " & "附件" & Sheets("CFD").Range("B" & i).Value & "</B></FONT>）.<BR><BR>" & _
    "KN was authorized by Daimler Northeast Asia Parts Trading and Services Co., LTD<BR>" & _
    "Guangzhou PDC to deliver automotive parts under PO   (<Font Face=Times Roman Size=4.5 Color=blue><B>" & Sheets("CFD").Range("A" & i).Value & "</B></FONT>)   to<BR>" & _
    "(<Font Face=Times Roman Size=4.5 Color=blue><B>" & Sheets("CFD").Range("F" & i).Value & "</B></FONT>).<BR>" & _
    "Regarding the transportation status of mentioned shipment, please check on <BR>" & _
    "KN website http://www.kn-portal.com/. <BR>" & _
    "Your tracking number is  (<Font Face=Times Roman Size=4.5 Color=blue><B>" & Sheets("CFD").Range("B" & i).Value & "</B></FONT>).<BR><BR><BR>" & _
    "谢谢!<BR>" & _
    "Thanks for your attention!<BR><BR><BR>" & _
    "xxxxxxx广州分公司<BR>" & _
    "xxxxxxx Guangzhou Branch Office</FONT>"
    MailItem.HTMLBody = StrMail
    MailItem.Send
    Set OutlookApp = Nothing
    Set MailItem = Nothing
    Set Recipient = Nothing
Next i
End Sub

canciaw

报告老师,测试成功了!!! 谢谢...

是不是加一个收件人,只能定义一个邮件地址,而作为To发送，就可以发多个收件人呢？

mineshine

我本來也不能确定，想了很多方法，参考之前留的那个英文网页，结果测试成功啦!!

canciaw

谢谢老师,浪费了您的时间去思考,真的抱歉!!!  也希望您的方案可以帮到更多的朋友!