Question

我在Outlook中创建了一系列宏来处理从支持客户那里收到的电子邮件。基本上有3个宏：

称为事件的事件，该事件只是用我的姓名缩写标记电子邮件，然后粘贴我从剪贴板创建的票证编号
被调用的请求，该电子邮件将我的姓名缩写放在方括号之间，并将其移动到名为“请求”的文件夹中。
称为Update的请求，该请求用文本$ UPDATE TO REQUEST $加上我的姓名首字母标记电子邮件：$ UPDATE TO REQUEST $（DR）-

一切正常，但是由于几个星期以来，副本也发送到了删除文件夹，在某些情况下，它会直接转到该删除文件夹，而没有副本到预期的副本。

除使用Exchange服务器的个人邮箱外，宏使用的邮箱是我们在Outlook中拥有的IMAP邮箱。我不明白为什么会突然这样做。

Option Explicit

Sub AddFileNumber()
    'add initials to the email header
    Dim myolApp As Outlook.Application
    Dim aItem As Object

    Set myolApp = CreateObject("Outlook.Application")
    Set aItem = myolApp.ActiveExplorer.Selection.Item(1)

    Dim iItemsUpdated As Integer
    Dim strTemp As String
    Dim strFilenum As Variant

    strFilenum = "(DR) - "
    If strFilenum = False Then Exit Sub
    If strFilenum = "" Then Exit Sub

    strTemp = "" & strFilenum & "" & aItem.Subject
    aItem.Subject = strTemp
    aItem.Save
End Sub

Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
    Case "Explorer"
        Set GetCurrentItem = _
        objApp.ActiveExplorer.Selection.Item(1)
    Case "Inspector"
        Set GetCurrentItem = _
        objApp.ActiveInspector.CurrentItem
    Case Else
    End Select
End Function

Sub MasterMacro()
    'add the initials and move the email to the selected folder
    Call Request.AddFileNumber
    Call Request.MoveSelectedMessagesToFolder
End Sub

Option Explicit

Sub UpdateRequest()
    ' adds $UPDATE TO REQUEST$ and initials to the email header
    Dim myolApp As Outlook.Application
    Dim aItem As Object

    Set myolApp = CreateObject("Outlook.Application")
    Set aItem = myolApp.ActiveExplorer.Selection.Item(1)

    Dim iItemsUpdated As Integer
    Dim strTemp As String
    Dim strFilenum As Variant

    strFilenum = "$UPDATE TO REQUEST$ (DR) - "
    If strFilenum = False Then Exit Sub
    If strFilenum = "" Then Exit Sub

    strTemp = "" & strFilenum & "" & aItem.Subject
    aItem.Subject = strTemp
    aItem.Save
End Sub

Option Explicit

Sub MoveSelectedMessagesToFolder()

    On Error Resume Next
    Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
    Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem

    Set objNS = Application.GetNamespace("MAPI")
    Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
    Set objFolder = objNS.Folders.Item("DOJ Helpdesk") _
        .Folders.Item("Inbox").Folders.Item("REQUESTS")

    If objFolder Is Nothing Then
        MsgBox "This folder doesn't exist!", vbOKOnly _
            + vbExclamation, "INVALID FOLDER"
    End If

    If Application.ActiveExplorer.Selection.Count = 0 Then

        Exit Sub
    End If
    For Each objItem In Application.ActiveExplorer.Selection
        If objFolder.DefaultItemType = olMailItem Then
            If objItem.Class = olMail Then
                objItem.Move objFolder
                objItem.UnRead = True
                objItem.Save
            End If
        End If
    Next

End Sub

Sub MasterUpdate()
    ' call both modules above
    Call Request.UpdateRequest
    Call Request.MoveSelectedMessagesToFolder
End Sub

Answer 1

1。您可以检查您的邮件规则，并查看规则是否已删除。

2。您可以检查Outlook加载项，并查看是否已删除电子邮件加载项。

3。您可以切换帐户并检查其他帐户是否发生相同情况。

用于移动电子邮件的Outlook Macro将副本发送到删除文件夹

1 个答案: