Excel VBA创建Outlook电子邮件规则(在最近的更新后中断)



对于我的工作,我有Office 365 ProPlus。在2018年12月11日的最新更新中,通过此链接详细介绍:https://learn.microsoft.com/en-us/officeupdates/monthly-channel-2018#version-1811年12月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

这以前是有效的,经过广泛的调试,我确定所有变量都正常工作,问题是实际上不再执行移动到文件夹的操作。

有人有什么想法吗?

我也有同样的问题。我发现

NewRule.Actions.MoveToFolder.Folder = oMoveTarget

有效,但不在您上面的"With"语句中。

其次是

NewRule.Actions.MoveToFolder.Enabled = True

给出错误,但是在结构中正确地设置了CCD_ 3。但如果保存了这些规则,它们就是不完整的。

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

H。

好的,所以我现在终于找到了解决方案。这只是一个变通方法,因为我发现这个问题实际上是从最近的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

最新更新