创建一个VBScript,在Outlook中搜索特定文件夹,并创建一个规则以将电子邮件移动到该文件夹

时间:2016-06-20 18:33:03

标签: vbscript outlook directory

我想创建一个要部署的脚本,该脚本将连接到outlook并创建一个规则,以根据正文中的文本将电子邮件移动到已创建的文件夹中。目前我无法弄清楚为什么我在第47行遇到“服务器抛出异常”错误。

这是我的代码:

'--> Create some constants
Const olRuleReceive = 0

'--> Create some variables
Dim olApp, olSession, olRuleDirectory, newRule, ruleConditions, ruleAction, folderDirectory, newFolder, moveFolder, index, ruleActiona
Dim folderexists


'--> Connect to Outlook
Set olApp = CreateObject("Outlook.Application")
Set olSession = olApp.GetNamespace("MAPI")
olSession.Logon olApp.DefaultProfileName

' --> Get the rules/folder collection
Set folderDirectory = olSession.GetDefaultFolder(6)
Set moveFolder = folderDirectory.Parent

For i = 1 To moveFolder.Folders.Count

    If moveFolder.Folders.item(i).Name = "One" Then
        index = i
        Exit For
    End If
Next

' set moveFolder = moveFolder.Folders.item(index)


Set olRuleDirectory = olSession.DefaultStore.GetRules()

'--> Create a new receive rule
Set newRule = olRuleDirectory.Create("Test", olRuleReceive)

'--> Set the rule's condition to look for a specific word in the subject

Set ruleConditions = newRule.Conditions.Body
With ruleConditions
    .Text = Array("test")
    .Enabled = True
End With

' --> Set the rule's action to move to folder

Set ruleAction = newRule.Actions.MoveToFolder 
 With ruleAction  
 .Enabled = True
 .Folder = moveFolder.Folders(index)  ' this is the part that needs work, a variable needs to be delcared earlier and set to a folder directory. 
 End With


'--> Save the rule
olRuleDirectory.Save False

'--> Disconnect from Outlook
olSession.Logoff
Set ruleConditions = Nothing
Set ruleAction = Nothing
Set newRule = Nothing
Set olRuleDirectory = Nothing
Set olSession = Nothing
Set olApp = Nothing

'--> Terminate the script
WScript.Quit

1 个答案:

答案 0 :(得分:0)

如果文件夹不存在,索引变量将被取消初始化。 请注意,您无需遍历所有子文件夹以查找具有给定名称的文件夹 - 只需使用set folder = moveFolder.Folders.Item("One")