用VBA让EXCEL批量发送邮件，正文+表格+正文，求完善。详细见1L最下方

xmashigh

1. Private Sub CommandButton1_Click()
   
2.   
   
3.   On Error Resume Next
   
4.   Dim rowCount, endRowNo As Integer
   
5.   Dim objOutlook As New Outlook.Application
   
6.   Dim objMail As MailItem
   
7.   endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
   
8.   Set objOutlook = New Outlook.Application
   
9. 
   
10.   Dim objData As New DataObject
    
11.     For rowCount = 2 To endRowNo
    
12.         Set objMail = objOutlook.CreateItem(olMailItem)
    
13.            
    
14.            With objMail
    
15.              .To = Cells(rowCount, 1).Value     '"收件人"
    
16.              .CC = Cells(rowCount, 2).Value     '"抄送人"
    
17.              .Subject = Cells(rowCount, 3).Value '"邮件主题"
    
18.              .HTMLBody = Cells(rowCount, 4).Value & getVal(rowCount) & "  " & Cells(rowCount, 5).Value '正文
    
19.               .Display
    
20.            End With
    
21.         Set objMail = Nothing
    
22.    Next
    
23. Set objOutlook = Nothing
    
24. End Sub
    
25. Function getVal(ByVal j As Integer) As String
    
26.   
    
27.    Dim i As Integer
    
28.    i = 6 '"你要发送表格的最左边一行行数"
    
29.    getVal = ""
    
30.    getVal = ""
    
31.    getVal = getVal & ""
    
32.        Do Until Cells(1, i) = ""
    
33.                getVal = getVal & ""
    
34.                i = i + 1
    
35.        Loop
    
36.        getVal = getVal & ""
    
37.        i = 6 '"你要发送表格的最左边一行行数"
    
38.        Do Until Cells(j, i) = ""
    
39.                getVal = getVal & ""
    
40.                i = i + 1
    
41.        Loop
    
42.        getVal = getVal & ""
    
43.                getVal = getVal & Cells(1, i) & ""
    
44.                getVal = getVal & Cells(j, i) & ""
    
45. End Function
    

复制代码

不能换行的问题也解决了 因为vba引用后责成了 HTML代码
用<br/>可以换行
对应的空格是  
设置字体是<div style="font-size:13px;font-family: Calibri；">    文字  </div>

现在问题是同一发件人 还会分开发送不同邮件，每个邮件内一行表头 一行数据。  求在一个邮件内发送2行及2行以上数据的办法  详情见附件
VBA发邮件.rar (16.43 KB, 下载次数: 445)

2012-2-15 20:56 上传

点击文件名下载附件

今天来了整理了一下 写了点说明   还有一个问题没解决，其他测试过了  完全没问题  HTML代码写有点麻烦  
等有时间了 写个编码自动转换的小文件出来 VBA发邮件-最终版.zip (70.28 KB, 下载次数: 1869)

2012-2-16 11:15 上传

点击文件名下载附件

现在这个表格效果是这样



如果收件人跟抄送人一样的话我想做到下图那样 合并数据列  求解

lhdcxz

参考：http://club.excelhome.net/thread-665669-1-1.html

xmashigh

lhdcxz 发表于 2012-2-15 15:43
参考：http://club.excelhome.net/thread-665669-1-1.html

看了 不太一样 不知道怎么修改

xmashigh

lhdcxz 发表于 2012-2-15 15:43
参考：http://club.excelhome.net/thread-665669-1-1.html

             .HTMLBody = Sheet2.Range("g5") & getVal(rowCount) & "  " & Sheet2.Range("g6") '正文

我加了一句这个

哈哈哈哈 可以加上正文了

xmashigh

lhdcxz 发表于 2012-2-15 15:43
参考：http://club.excelhome.net/thread-665669-1-1.html

但是正文的变量每行都不一样  怎么修改呢  现在G5+表格+G6

xmashigh

解决了

             .HTMLBody = Cells(rowCount, 13).Value & getVal(rowCount) & "  " & Cells(rowCount, 14).Value '正文

xmashigh

求解 怎么换行

lhdcxz

& chr(13) &

xmashigh

lhdcxz 发表于 2012-2-15 17:19
& chr(13) &

不知道这个咋用，在excel中 非vba中

能给我个文本+chr(13)的例子吗

=“文本”

往后咋写呢？

lhdcxz

=“文本”& CHAR(10)