邮件客户端vba源码（vba 邮件发送）
本文目录一览：
- 1、如何用VBA代码控制OUTLOOK发送邮件
- 2、有没有能使用Excel调用OUTLOOK或者Foxmail发邮件的工具，源代码也行，也就是VBA的。
- 3、各位高手，帮帮忙，我想用指定的邮箱批量发送邮件的VBA代码，求写
- 4、如何使用VBA调用outlook发送邮件源码
- 5、outlook vba发邮件问题
如何用VBA代码控制OUTLOOK发送邮件
'我一直是这样用的
Sub SendMail()
Set myOlApp = CreateObject("Outlook.Application")
Set objMail = myOlApp.CreateItem(olMailItem)
With objMail
.To = "收件人邮箱地址"
.Subject = "邮件主题"
.Body = "邮件正文内容"
.Attachments.Add "附件完整路径，如：D:\1.docx"
.Send
End With
End Sub
运行正常，已经用了一年多了。放在excel或word里都行。
有没有能使用Excel调用OUTLOOK或者Foxmail发邮件的工具，源代码也行，也就是VBA的。
其实Excel文件菜单里有选项可以直接把文档发送Email，不过调用的是Windows默认内嵌的OutLookExpress程序。
各位高手，帮帮忙，我想用指定的邮箱批量发送邮件的VBA代码，求写
可以将附件上传到服务器，然后利用u-mail邮件营销平台的变量功能来实现
如何使用VBA调用outlook发送邮件源码
'将发件箱中的邮件发送出去
Sub subSendEmail()
On Error Resume Next
Dim fld_OutBox As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim myItem As Object
Dim myItems() As Object
Dim iIndex As Integer
iIndex = 0
Dim n As Integer
'获得发件箱
Set fld_OutBox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderOutbox)
Set objItems = fld_OutBox.Items
If fld_OutBox.Items.Count = 0 Then
'如果发件箱邮件数为0从草稿箱中移动邮件
'从草稿箱中移动若干邮件到发件箱
funMoveMailToOutBox 15
End If
'如果发件箱存在对象，对其中的邮件执行发送
If objItems.Count 0 Then
For n = 1 To objItems.Count
If (objItems(1).Class = 43) Then
'发送邮件
objItems(n).Send
End If
Next n
End If
End Sub
outlook vba发邮件问题
仔细看了一下，原来的代码的确有些问题，这个是我现在用的，我一次只能发不超过15封邮件，否则邮件网关（单位自有邮件服务器）会阻止我。延迟发送是我加的，没有测试。
我下面的代码是在如下情况下使用（很有必要说清楚）。
就我自用来说。
首先，我有一个excel文件，其中存放的是的待发送人员的姓名以及邮件地址。
其次，我会将网络断开，使用word的邮件功能，并使用上述excel中的邮件地址，合并，并批量生成邮件。
之后，因为网络断开，本来要通过outlook发送的邮件，都会因为发送失败出现在发件箱中。出于方便操作和手动控制发送节奏的目的，将发件箱中所有发送失败的邮件拷贝到草稿箱。
最后，重新连接网络，使用上述代码手动一次发个10封左右的邮件，我是发一次歇一会。发送邮件通过vba添加附件。（你所要求的延迟，是我临时加的，没有经过测试）如果加了延迟，你可以修改vba中，一次复制到发件箱邮件的个数，控制时间间隔。（也可以一次复制完毕，我出于测试的目的，第一次通常会用程序从草稿箱移动2个邮件发送，然后检查看有无错误，以免错误过大难以控制）
希望对你有帮助，附现在用的代码。
Option Explicit
'将草稿箱中的邮件发送出去
Const strAttachmentPath = "" '附件路径E:\办公\科研处\国家基金要点提示\2014自然基金模板及简明指南摘要.rar
Const intMailCount = 10 '单次发送邮件数
Sub subSendEmail()
'On Error Resume Next
Dim fld_OutBox AsOutlook.MAPIFolder
Dim objItems As Outlook.Items
Dim myItem As Object
Dim myItems() As Object
Dim iIndex As Integer '延迟技术器
Dim intervalMinute As Integer '延迟分钟数
Dim objMail As Outlook.MailItem
iIndex = 1
Dim n As Integer
If MsgBox("附件:" strAttachmentPath vbCrLf "单次发送邮件数:" intMailCount vbCrLf "以上信息正确与否？", vbOKCancel) vbOK Then
Exit Sub
End If
'获得发件箱
Set fld_OutBox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderOutbox)
Set objItems = fld_OutBox.Items
If fld_OutBox.Items.Count = 0 Then
'如果发件箱邮件数为0从草稿箱中移动邮件
'从草稿箱中移动若干邮件到发件箱
funMoveMailToOutBox intMailCount
End If
'如果发件箱存在对象，对其中的邮件执行发送
If objItems.Count 0 Then
For Each objMail In objItems
If (objMail.Class = 43) Then
'发送邮件
If (strAttachmentPath "") Then
'存在附件路径,添加附件
objMail.Attachments.AddTrim(strAttachmentPath), olByValue, 1
End If
'延迟发送
'iIndex = iIndex + 1
'objMail.DeferredDeliveryTime =DateAdd("n", iIndex * intervalMinute, Now)
objMail.Send
End If
Next
End If
End Sub
Function funMoveMailToOutBox(ByVal numEmailAs Integer) As Boolean
'移动numEmail指定的邮件数从draft到outBox
'On Error Resume Next
Dim fld_OutBox AsOutlook.MAPIFolder
Dim fld_Drafts AsOutlook.MAPIFolder
Dim objItemsDrafts AsOutlook.Items
Dim objMail As Outlook.MailItem
Dim n As Integer
n= 0
'获得发件箱对象
Set fld_OutBox =Application.GetNamespace("MAPI").GetDefaultFolder(olFolderOutbox)
'获得草稿箱对象
Set fld_Drafts =Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)
Set objItemsDrafts = fld_Drafts.Items
'按照numEmail指定的数值移动邮件
While (objItemsDrafts.Count 0) And (n numEmail)
'如果草稿箱不为空
Set fld_Drafts =Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)
Set objItemsDrafts = fld_Drafts.Items
Set objMail = objItemsDrafts.GetFirst()
If (objMail.Class = 43) Then
objMail.Move fld_OutBox
Else
Exit Function
End If
n = n + 1
Wend
End Function
