Question

如何使用VBA自动发送多个（当前可见的）草稿项目？请帮忙，谢谢。

编辑：这是一个很难的案例，目前还没有任何项目在草稿文件夹中。这些是屏幕上生成的电子邮件，等待发送。

Edit2：nvm，无论如何都没有帮助。我的脚本创建了大约500封电子邮件，并显示前100个导致内存不足错误。我选择自动发送它们而不显示（它以这种方式打破了布局，但它是我现在唯一的选择。）

Answer 1

碰巧我之前遇到了同样的问题并且代码很方便。如果您尚未使用Outlook，则需要在VBA IDE中添加引用，工具---＆gt;引用...并选中“Microsoft Outlook 14.0对象库”旁边的框。

Dim oFolder As Folder
Dim oNS As NameSpace
Dim olMail As MailItem

If (MsgBox("Are you sure you want to send ALL EMAILS IN YOUR DRAFTS FOLDER?", vbYesNo + vbCritical, "WARNING: THIS WILL SEND ALL DRAFTS")) = vbYes Then
    Set oNS = Outlook.Application.GetNamespace("MAPI")

    Set oFolder = oNS.GetDefaultFolder(olFolderDrafts)

    For i = 1 To oFolder.Items.Count
      oFolder.Items(1).Send
    Next
End If

Set oNS = Nothing

Answer 2

这是一些代码。将Your Name中的myFolders("Mailbox - Your Name")替换为邮箱中显示的实际名称。

Public Sub EmailOutlookDraftsMessages()

Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder

'Send all items in the "Drafts" folder that have a "To" address filled in.

'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders

'Set Draft Folder.
Set myDraftsFolder = myFolders("Mailbox - Your Name").Folders("Drafts")

'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1

'Check for "To" address and only send if "To" is filled in.
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then

'Send Item
myDraftsFolder.Items.Item(lDraftItem).Send

End If

Next lDraftItem

'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing

End Sub

源代码改编自this Question's回答。

在Outlook 2007中使用VBA发送所有“可见”草稿

2 个答案: