关于notre大神的邮件批量发送

johnwalk · 发表于 2015-10-31 11:09

本帖最后由 johnwalk 于 2015-10-31 12:07 编辑

邮件批量发送
http://club.excelhome.net/thread-781973-1-1.html
(出处: ExcelHome技术论坛)

非常棒的一个东西，还无私的分享出源码
里面东西很有用自己也正好在学习vba
想就学习notre的东西，分享一点自己的学习体会

Dim myolapp As Object
Sub Send_Mails()
'On Error Resume Next
Dim subject As String
Dim i As Integer
Dim l As Integer
Dim wst As Worksheet
Dim myitem
Dim y As Long
Dim z As String
Set wst = ThisWorkbook.ActiveSheet
subject = wst.Range("Subject").Value
Set myolapp = CreateObject("outlook.application")
i = wst.Range("Receiver").End(xlDown).Row - wst.Range("Receiver").Row
z = Len(wst.Range("Att").Offset(l, 0).Value)
For l = 1 To i
Set myitem = myolapp.CreateItem(olMailItem)
With myitem
.subject = subject
.To = wst.Range("Receiver").Offset(l, 0)
.cc = wst.Range("CCer").Offset(l, 0)
.BodyFormat = 3
.Body = MailBody(l, wst)
'.display
y = 1
Do
x = InStr(y, wst.Range("Att").Offset(l, 0).Value, ";")
If x = 0 And y <> 1 Then
z = Mid(wst.Range("Att").Offset(l, 0).Value, y, Len(wst.Range("Att").Offset(l, 0).Value) - y + 1)
ElseIf x = 0 And y = 1 Then
z = wst.Range("Att").Offset(l, 0).Value
Else
z = Mid(wst.Range("Att").Offset(l, 0).Value, y, x - y)
End If
y = x + 1
.Attachments.Add z
Loop Until x = 0
.Send
End With
Next
'myolapp.Quit
Set myolapp = Nothing
Set myitem = Nothing
End Sub
Function MailBody(l As Integer, wst As Worksheet)
'On Error Resume Next
Dim wapp As Object
Dim wb As Object
Dim k As Integer
Dim j As Integer
Set wapp = CreateObject("word.application")
Set wb = wapp.Documents.Open(wst.Range("Content").Value)
k = wst.Range("replace").End(xlToRight).Column - wst.Range("replace").Column
For j = 0 To k
wb.content.Find.Execute findText:=wst.Range("replace").Offset(0, j), Replacewith:=wst.Range("replace").Offset(l, j), Replace:=2
Next
MailBody = wb.content.Text
wb.Close SaveChanges:=False
wapp.Quit
Set wb = Nothing
Set wapp = Nothing
End Function

复制代码

johnwalk · 发表于 2015-10-31 11:43

本帖最后由 johnwalk 于 2015-10-31 11:44 编辑

复制代码

先表达对大神的敬仰之情。高手必须的
好了不说废话了
首先不说vba
先说表本身，大神在表中定义了6个名称。一是锚定，2是方便调用。真是一个好用的技巧
我们先看看定义了那些名称
挺多的用一下vba 获取一下把

Sub nn()
Set nms = ActiveWorkbook.Names
Set wks = Worksheets(1)
For i = 1 To nms.Count
wks.Cells(i + 18, 2).Value = nms(i).Name
wks.Cells(i + 18, 3).Value = nms(i).RefersToRange.Address
Next
End Sub

复制代码

johnwalk · 发表于 2015-10-31 11:53

上述代码解释：
名称对excel来说有个集合 names
集合一出哪个对象都跑不了
通过使用for循环遍历通过集合的索引 “引用”names中所有的元素

返回name的名称和引用位置

并把它赋值给cells
这里的cells是
Worksheet.Cells 属性

返回一个 Range 对象，因为 Item 属性是 Range 对象的默认属性（默认属性：可以对控件设置的属性，以使每次新建该类型的控件时，这个属性的值都相同。），所以可以在 Cells 关键字后面紧接着指定行和列索引
运行上述代码

johnwalk · 发表于 2015-10-31 12:05

Att	$D$13:$D$13
CCer	$C$13:$C$13
Content	$B$11:$B$11
Receiver	$B$13:$B$13
Replace	$E$13:$E$13
Subject	$B$10:$B$10

我们得到了表中的全部名称的信息。大神初步打算依次代表附件地址、抄送人、内容、收件人、邮件body中自定义部分、邮件主题
看看大神构思就是比小白强多了（我会说我是跪着写完这些的么）

这里再次感谢一下大神notre
良好的习惯怕vba代码我这种小白看不懂，（其实也怕时间久了自己也忘了）
为何要麻烦的在表中定义这么多名称呢
1、代码好读一些
2、方便range调用
因为range可以识别工作簿中的名称

不过话说range到底特么的事对象还是属性？？？

johnwalk · 发表于 2015-10-31 16:18

好吧  说完表格本身回到代码吧
大神的代码清晰  已读  我等小白都能看懂
简而言之分为一个主过程sub和一个自定义的函数function
运用office对象 outlook和word等方法  等application级的对象实现发邮件的过程
来看看代码吧

01 Dim myolapp As Object  这里声明dim了一个对象object变量我一般念欧巴姐对象大神是想干嘛呢看看变量的名字 myolapp
噢，my=俺的ol=officelady app=爱pp  就是说相当于一个officelady回来帮你发邮件幸福啊
接下来看看

Sub Send_Mails()
sub一个过程叫发邮件简单直白点赞
'On Error Resume Next
这里明显是个猪死了
Dim subject As String
继续声明变量大神还是很规范的给了个字符串类型是用来干嘛的呢？
哦原来是为了存储邮件主题的说
Dim i As Integer
来个整形  变量  其实改成mailnumber 更好理解
Dim l As Integer
又来个整形
一般来整形变量的都是用来计个数啊控制个小循环啊搞一个动态引用啊什么的
真的不骗你
Dim wst As Worksheet
来一个表对象起名叫wst 文森特有个名字好叫上面搞个i啊l啊什么的多没有格调啊
这个wst后面会立功的他将作为间谍打入敌人的内部
Dim myitem
又声明一个。。。。。我去这个是啥不知道  其实系统也不知道但最后会知道的
Dim y As Long
来来个龙型变量龙嘛  一般都会长一点好吧其实龙的体积就等于2个integer
Dim z As String
好的又来一个字符串

变量定义完了内存地址也都分配好了，其实我觉得大神这个啥写的还是很随意的，。能发出去就差不多了
变量的目的就是要被赋值，往内存里面写点0101010101吧

Set wst = ThisWorkbook.ActiveSheet
让文森特去代表这个希特对象。对象一般都会吊一些非要射它一下，下边的数值只穿都很nice的
subject = wst.Range("Subject").Value
噢  色不接也被赋值了被文森特的range使用表中的name调用了  话说value不是默认属性么
Set myolapp = CreateObject("outlook.application")
哦天啊  玛德西亚，无中生有出大招一来就创建一个outlook对象  还是appliacat级的
我们的officelady要要进入状态了
byw，您的outlook部署好了么，库挂了么
i = wst.Range("Receiver").End(xlDown).Row - wst.Range("Receiver").Row
这个不多说了前面有奖。关键是明白Range("Receiver").End(xlDown)
这是个方法还是属性？麻蛋不管了 vba就是这么蛋筒。我们只要知道结果也是一个range
但是这个让哥是个单元格是包含 receiver这个单元格的区域的边缘的位置
end 其实就是end捡 xl+上下左右有为你指明方向xlup xldown xltoleft xltoright
微软就是这么任性

对了要小心空格  还要小心假空白
row肉属性单元格行号
vba水真深  我都不想学了  哎~~~

好吧蒸腾半天  电脑终于知道要发的信的数量了
z = Len(wst.Range("Att").Offset(l, 0).Value)
这里啊  数数附件有多长楞为啥  有用啊
来了个offset 这里啊就不说了非常重要的一个属性  最好百度一下
太长就不说了健儿研究就是返回一个range 哪里的rangge呢  offset给你坐标
这里是l，0  不是1,0  所以说啊特么坑人啊
L还没有赋值一般系统给个默认值 0
好现在知道了坐标 0，0  额？特么还在原地啊
2个字儿。。。我们知道原地的情况就是俩字儿附件儿（我是北京儿的说话就这样儿）
其实到这里大家会发现前面有个地方大神写的不太合适  不知道大家看出来没有
猜对有奖
好了太累了歇一下 88

johnwalk · 发表于 2015-10-31 16:22

累死了写了半天居然有敏感词帮主帮我改改别删@版主

johnwalk · 发表于 2015-11-1 21:06

到了关键的地方了，技术含量就要在这里体现了，
其实想画一个流程图的，无奈昨晚重装系统，驱动还没有装好呢。
好吧，不说废话了，
主要部分用了两个循环完成，ipqadmini打字好累

johnwalk · 发表于 2015-11-1 21:17

好了 iamback 上网打痣还是用笨笨的好 hp的 probook 还不错就是重了点好在不烫手不烫腿价钱便宜
还送免费正版的win导师真不是在做广告
废话太多我改我改
接下来：2个循环
一个就是for next
一个就是潜逃在里面的do loop until
外层循环主要解决了在outlook里面创建邮件项目的问题
内层do loop until 主要是解决多附件的问题

		自动登录	找回密码
密码			免费注册

[原创] 关于notre大神的邮件批量发送