excel vba 批量发送邮件邮件内容放入表格

zhengjunhong123

很多人需要,最近在同事的帮助下终于完成这个,现发布出来共享一下!

Private Sub CommandButton1_Click()
  
  On Error Resume Next
  Dim rowCount, endRowNo As Integer
  Dim objOutlook As New Outlook.Application
  Dim objMail As MailItem
  endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
  Set objOutlook = New Outlook.Application

  Dim objData As New DataObject
    For rowCount = 2 To endRowNo
        Set objMail = objOutlook.CreateItem(olMailItem)
           
           With objMail
             .To = Cells(rowCount, 1).Value     '"fantasia@sina.com"
             .Subject = Cells(rowCount, 2).Value '"邮件主题"
             .HTMLBody = getVal(rowCount)
              .Display
              .Send
           End With
        Set objMail = Nothing
   Next
Set objOutlook = Nothing
End Sub
Function getVal(ByVal j As Integer) As String
  
   Dim i As Integer
   i = 3
   getVal = ""
   getVal = "<table border=" & "'1'" & " style=" & "'border-right: black thin solid; border-top: black thin solid; border-left: black thin solid; border-bottom: black thin solid'" & ">"
   getVal = getVal & "<tr>"
       Do Until Cells(1, i) = ""
               getVal = getVal & "<td align=" & "'left'" & " height=" & "'57'" & " style=" & "'width: 250px; background-color: lightskyblue; font-size: 9pt; font-family: 宋体;border-right: windowtext 0.5pt solid; border-top: windowtext 0.5pt solid;border-left: windowtext 0.5pt solid;border-bottom: windowtext 0.5pt solid;'" & " valign=" & "'top'" & ">"
               getVal = getVal & Cells(1, i) & "</td>"
               i = i + 1
       Loop
       getVal = getVal & "</tr>"
       i = 3
       Do Until Cells(j, i) = ""
               getVal = getVal & "<td align=" & "'left'" & " style=" & "'width: 239px;background-color: lightskyblue; font-size: 9pt; font-family: 宋体;border-right: windowtext 0.5pt solid; border-top: windowtext 0.5pt solid;border-left: windowtext 0.5pt solid;border-bottom: windowtext 0.5pt solid;'" & " valign=" & "'top'" & ">"
               getVal = getVal & Cells(j, i) & "</td>"
               i = i + 1
       Loop
       getVal = getVal & "</tr></table>"
End Function

Admin

   

很遗憾通知楼上朋友，您的帖子在24小时之内没有任何回复！

通常情况下，本论坛发布的主题帖会在8小时被回复或处理。您的帖子在24小时之内未被回复，其中的原因可能是：

1、问题表述不清、模棱两可，难以理解，帮助者被搞晕了，夺帖而出；
2、没有上传必要的附件，或附件被遗忘在某个角落；
3、发帖提问时，语气带棱角、带挑衅，不幸被列入不受欢迎的帖子；
4、所提问题不成立，或提不合理的要求，乐于助人者使出“走为上”之计；
5、话题较偏、较冷或者发布到了不合适的版块，暂时无人问津，顾影自怜。


为了提高您的问题解决效率，我们推荐您阅读以下文章：
* 如何发表新话题和上传附件：http://club.excelhome.net/thread-45649-1-1.html
* 发帖的技巧：http://club.excelhome.net/thread-176339-1-1.html
* EH技术论坛的最佳学习方法：http://club.excelhome.net/thread-117862-1-1.html

cotine

你要是有视频演示 直观点 可能关注的人会多点 我个人觉得还是很有价值

cbtaja

这个东东有点意义，做个记号学习和备查。

120HYH

谢谢共享，学习了。

zhengjunhong123

谢谢各位关注呀!

gjb_zjf

谢谢分享！！！

cnfeng

真的很有帮助
我还需要认真研究学习

xiegengzhe

这东西不错，帮顶了

ivanzh

太好了，就找这个，请问你链接的邮箱怎么搞的？是公司的outlook吗？
、