鲁达 Private Sub CommandButton1_Click()
Dim arr()
arr = A("所有支持文件 (*.xls;*.xlsx;*.CSV),*.xls;*.xlsx;*.csv,Excel 文件 (*.xls),*.xls,Excel2007 文件 (*.xlsx),*.xlsx,CSV 文件 (*.csv),*.csv", , "选择文件", , True)
For i = LBound(arr) To UBound(arr)
Tex = arr(i)
Next
End Sub
Private Sub 全自动发送邮件_Click()
'要能正确发送并需要对Microseft Outlook进行有效配置
On Error Resume Next
Dim rowCount, endRowNo, endColumnNo, sFile$, sFile1$, A&, B&
Dim objOutlook As Object
Dim objMail As MailItem
Dim myAttachments As ou
Dim MyItem As ou
If Tex = "" Then
MsgBox "未选择文件"
End
Else
MsgBox "发送邮件"
End If
'取得当前工作表数据区行数列数
endRowNo = Ac
endColumnNo = Ac
'取得当前工作表的名称，用来作为邮件主题进行发送
sFile1 = Ac
'创建objOutlook为Outlook应用程序对象
Set objOutlook = CreateObject("Ou;)
'开始循环发送电子邮件
For rowCount = 2 To endRowNo
'创建objMail为一个邮件对象
Set objMail = objOu(olMailItem)
'设定邮件模板所在的位置
Set MyItem = objOuFromTemplate("d:\02.oft")
With objMail
'多OUTLOOK账号设定所发送的邮箱序列（1为第一个，2为第二个）
MyI = objMail.Se(1)
'设置收件人地址，数据源所在列数
MyI = Cells(rowCount, 2)
'设置抄送人地址（从通讯录表的'E-mail地址'字段中获得）
'MyI = "11111@qq.com;222222@qq.com"
'设置邮件主题,取值工作表名，
MyI = Format(Date, "yyyy年m月d日") + "测试"
'设置邮件内容(从通讯录表的“内容”字段中获得)
'align 单元格文本显示方式 left(向左)、center(居中)、right(向右)，默认是center, width-宽 height-高 border 单元格线粗细,bordercolor返回或设置对象的边框颜色
'colSpan是一种编程语言，其属性可设置或返回表元横跨的列数
'所发送邮件的附件的路径
MyI (Tex)
B = 1
For A = 1 To endColumnNo
'数据表头中添加“X”后将不发送此字段
If A(Cells(1, A), "*X*") = 0 Then
If B = 1 Then
sFile = sFile + "<tr><Font Face='微软雅黑' Color=red> <td width='20%' height='25' align='center' > " + Cells(1, A).Text + " </td> <td width='30%' height='25' align='center'> " + Cells(rowCount, A).Text + "</td>"
B = 0
Else
sFile = sFile + "<td width='20%' height='25' align='center' > " + Cells(1, A).Text + " </td> <td width='30%' height='25' align='center'> " + Cells(rowCount, A).Text + "</td> </tr>"
B = 1
End If
End If
Next
'邮件的内容，这里取上面路径中邮件模板中的内容
MyI
' .HTMLBody = sFile
'设置附件(从被选择的路径选取)
' .A (Tex)
'自动发送邮件
MyI
End With
'销毁objMail对象
Set objMail = Nothing
Set MyItem = Nothing
Next
'销毁objOutlook对象
Set objOutlook = Nothing
'所有电子邮件发送完成时提示
MsgBox rowCount - 2 & " 份订单发送成功！"
'清空文本框
Tex = ""
' S("全自动发送邮件").Delete
End Sub