Question

我想在回复活动邮件后删除该活动邮件，然后打开该文件夹中的下一个项目。

我找到了this answer，添加了 'olItem.Delete' ，但需要“打开下一个邮件项目”。

Sub ReplyMSG()
    Dim olItem As Outlook.MailItem
    Dim olReply As MailItem ' Reply
    Dim olRecip As Recipient ' Add Recipient
    Dim objInsp As Outlook.Inspector
    Dim objActionsMenu As Office.CommandBarControl

    For Each olItem In Application.ActiveExplorer.Selection
        Set olReply = olItem.Reply
        olReply.HTMLBody = "Thank you!" & vbCrLf & olReply.HTMLBody
        olReply.Send objInsp.CommandBars.ExecuteMso(478)
        objActionsMenu.Execute
    Next olItem
End Sub

Answer 1

您应该处理Activeinspector.CurrentItem而不是选择。如果您打开保留邮件，在资源管理器窗口中进行其他选择，返回到现在未选中的原始邮件，则该链接中的代码将与预期的行为不同。

要删除后转到下一个项目，请尝试模拟删除按钮上的单击。

这两个想法都在这个answer中得到了证明。

Sub SetEditMode()
Dim myItem As Outlook.MailItem
Dim objInsp As Outlook.Inspector
Dim objActionsMenu As Office.CommandBarControl
Dim olNewMailItem As Outlook.MailItem

On Error Resume Next ' Bad coding do not do this

Select Case TypeName(Application.ActiveWindow)
    Case "Explorer"
        Set myItem = ActiveExplorer.Selection.Item(1)
        myItem.Display
    Case "Inspector"
        Set myItem = ActiveInspector.CurrentItem
    Case Else
End Select
If myItem Is Nothing Then GoTo ExitProc
'edit mode
Set objInsp = ActiveInspector
objInsp.CommandBars.ExecuteMso ("EditMessage")
objActionsMenu.Execute

ExitProc:
End Sub

使用此提示来引用您的邮件。

Set myItem = ActiveInspector.CurrentItem

使用此提示点击按钮。

objInsp.CommandBars.ExecuteMso ("EditMessage")

EditMessage是一个Mso ID / Control ID。您可以通过hovering over the icon找到删除按钮的Mso ID，您可以在其中向快速访问工具栏或功能区添加按钮。

您可以在此处下载2007 Office System Document: Lists of Control IDs

列表

编辑：2016-02-22

控件ID可能无法正常工作。使用悬停技术。

Sub Reply_ExecuteMso_DeleteOriginal()
'
' ** NOT working as intended **
'
' Simulating clicking the delete button is too fast
'  Must slow down with a MsgBox
'
' Now it is the same as clicking delete manually
'
Dim olItem As Object
Dim olReply As mailItem
Dim objInsp As Inspector

Select Case TypeName(Application.ActiveWindow)
    Case "Explorer"
        Set olItem = ActiveExplorer.Selection.Item(1)
        olItem.Display
    Case "Inspector"
        Set olItem = ActiveInspector.currentItem
End Select

If olItem Is Nothing Then GoTo ExitProc

If olItem.Class = olMail Then

    Set olReply = olItem.Reply
    olReply.Display

    olReply.HTMLBody = "Thank you!" & vbCrLf & olReply.HTMLBody
    olReply.send

    olItem.Display
    Set objInsp = ActiveInspector
    objInsp.CommandBars.ExecuteMso ("Delete")

End If

MsgBox "This slows down the processing."

On Error Resume Next
' Error when no items left
Set olItem = ActiveExplorer.Selection.Item(1)
olItem.Display
On Error GoTo 0

ExitProc:
    Set olItem = Nothing
    Set olReply = Nothing
    Set objInsp = Nothing

End Sub

Answer 2

请记住更新文件夹名称

<强> olFolderName = "TEMP"

Sub Open_Next_olMessage()
    Dim olNamespace As Outlook.NameSpace
    Dim olFolder As MAPIFolder
    Dim olItem As MailItem
    Dim olReply As MailItem
    Dim olFolderName As String
    Dim olMsgBox As Integer
    Dim Cancel As Boolean

    olFolderName = "TEMP" '<-- Update Folder Name

'   // Set Inbox/SubFolder
    Set olNamespace = Session.Application.GetNamespace("MAPI")
'                                                             --> Folder Name
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox).Folders(olFolderName)

'   // Loop through items in folder
    For Each olItem In olFolder.Items
        If (olItem.Class = olMail) Then
            olItem.Display True

            olMsgBox = MsgBox("Do you want to Reply to this Email", vbYesNoCancel)
            Set olReply = olItem.ReplyAll ' or Reply
            Set olItem = olItem

            If olMsgBox = vbCancel Then
                Cancel = True ' Exit
                Exit Sub
            ElseIf olMsgBox = vbYes Then
                   olReply.Display True
            ElseIf olMsgBox = vbNo Then
'                  do something
            End If

            olItem.Delete ' Delete Message
        End If
    Next

End Sub

回复有效电子邮件 - 添加文字，发送，删除＆amp;然后打开下一个邮件项目

2 个答案: