时间戳

首页 > 解决方案 > 从功能区上的按钮将邮件移动到文件夹

vba - 从功能区上的按钮将邮件移动到文件夹

问题描述

我有一个宏，可以使用 F8 完美运行以逐步执行，但在从功能区上的按钮运行时会跳过最后一步，移动电子邮件。

这是代码。

Sub Reportmail()
    'Declare Variables
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    Dim msg As Outlook.MailItem
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objItem As Outlook.MailItem
    Dim Move As Outlook.MailItem
    Dim selEmail As Outlook.MailItem
    Dim moveToFolder As Outlook.MAPIFolder
    Dim MItem As MailItem

    'Append subject & Move
    For Each MItem In ActiveExplorer.Selection
        MItem.Subject = "Suspicious Email: " & MItem.Subject
    Next
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
    On Error GoTo xyz
    Set myNewFolder = olFolder.Folders.Add("Suspicious Items")

    xyz:
    Set olFolder = olFolder.Folders("Suspicious Items")
    Set objNS = Application.GetNamespace("MAPI")
    'Set folder to move suspicious email into
    Set objDestFolder = objNS.GetDefaultFolder(olFolderInbox).Folders("Suspicious Items")
 
    'SET Task
    Set selEmail = ActiveExplorer.Selection.Item(1).Forward
    'Set Recipient
    selEmail.Recipients.Add "myemail@mydonain.com"
    'Send Email
    selEmail.Send

    'Move email to folder
    ActiveExplorer.Selection.Item(1).Move objDestFolder   
End Sub

标签： vbaoutlook

解决方案

您可以通过添加错误捕获来调试问题，并在错误发生时检查错误消息和变量的值，方法是添加：

    On Error GoTo oops
    {your code}
finish:
    On Error GoTo 0
    Exit Sub
oops:
    Debug.Print Err.Number;Err.Description
    Debug.Assert False
    Resume finish
End Sub

推荐阅读