Question

对于我的工作，我有Office 365 ProPlus。在12/12/2018最新更新中，详细说明了此链接： https://docs.microsoft.com/en-us/officeupdates/monthly-channel-2018#version-1811-december-11

我在excel电子表格中有一些代码在此更新后中断。该代码的目的是更新电子邮件规则，以将电子邮件移动到主题行中具有特定编号的特定文件夹。该代码在更新之前有效，但现在由于“内存溢出”错误而中断。

这是代码，中断发生在.Enabled = True：

' Assign a specific action to take when the criteria is met
Set NewRuleAction = NewRule.Actions.MoveToFolder
With NewRuleAction
    .Folder = oMoveTarget       ' Tell the rule what target folder to use
    .Enabled = True             ' Make the rule active (turn it on - same as placing a checkmark in the box next to the rule name in Outlook.
End With

这以前可行，经过大量调试后，我确定所有变量都正常运行，问题是实际上不再执行对文件夹的移动。

有人有什么主意吗？

Answer 1

我在这里有同样的问题。我发现了

NewRule.Actions.MoveToFolder.Folder = oMoveTarget

可以使用，但不能在您上面的“ With”语句中使用。

第二个是

NewRule.Actions.MoveToFolder.Enabled = True

出现错误，但在结构中正确设置了Enabled。但是，如果保存规则，则它们是不完整的。

所以目前只有一部分解决方案。

H。

Answer 2

好的，所以我终于找到了解决方案。这只是一个解决方法，因为我发现此问题实际上是从最近的Microsoft Update创建的一个已知问题。与此处显示的问题相关的内存不足问题。

https://support.office.com/en-us/article/outlook-error-the-operation-failed-when-selecting-manage-rules-alerts-64b6ff77-98c2-4564-9cbf-25bd8e17fb8b

所以这是我暂时解决问题的方法。在Outlook中手动创建电子邮件规则。然后在代码中，循环浏览电子邮件规则，直到找到名为所需内容的规则。然后编辑条件主题并保存。您无法创建新规则，因为无法设置.Enabled = True。这是我现在拥有的代码。

Option Explicit
Sub RemoveandCreateRule()
Dim outlookObject As outlook.Application            'We need to define the actual Outlook Application
Dim oNamespace As Namespace                         'Define the Namespace from the Application (should also pull the current session)
Dim Account As outlook.Folder                       'Define the v- account that we will be using to get and send rules
Dim serverRules As outlook.Rules                    'The current rules in the server.
Dim newRule As outlook.Rule                         'The object to store the new rule in (which will be uploaded to the server.
Dim newSrArray() As String                         'The array to store all the SRs (to be put in the rule conditions)
Dim newSrListing As String
Dim i, counter As Integer

'-----------------------------------------------------------------------------------------------------------------
'Start initializing Account related variables.
'Start wtih the Application (getting the current Outlook Application)
Set outlookObject = GetObject(, "Outlook.Application")

'Then get the namespace from the current outlook application (specifically the "MAPI" namespace)
Set oNamespace = outlookObject.GetNamespace("MAPI")

'Once the namespace is selected, set the "email" account by finding the one that starts with "email"
For i = 1 To oNamespace.Accounts.Count
    If InStr(1, oNamespace.Accounts(i).DisplayName, "email") = 1 Then
        Set Account = oNamespace.Folders(oNamespace.Accounts(i).DisplayName)
    End If
Next

'-------------------------------------------------------------------------------------------------------------------
'Start initializing rule related variables. Find the rule that is named My Cases so we can edit it.
Set serverRules = Account.Store.GetRules

For counter = 1 To serverRules.Count
    If serverRules.Item(counter).Name = "My Cases" Then   ' NewRuleName already exists
        Set newRule = serverRules.Item(counter)
        Exit For
    End If
Next

'-------------------------------------------------------------------------------------------------------------------
'Get the list of SR's separate them into an array of strings, and then add them as subject conditions in the rule.

' Use the Split function to split a long string into elements and enter those into a one dimentional array.  Delimeter defaults to a space ( " ").
newSrListing = buildSRnumberList
newSrArray = Split(newSrListing)

newRule.Conditions.Subject.text = newSrArray
newRule.Conditions.Subject.Enabled = True

' Update the Exchange server with your new rule!
serverRules.Save

MsgBox ("Your email rules were updated and contain the following SR Numbers: " & newSrListing)
End Sub

Excel VBA创建一个Outlook电子邮件规则（在最新更新之后被破坏）

2 个答案: