以前は Outlook 2007 を実行していましたが、参照パターンが設定されているメールとそうでないメールを並べ替えるスクリプトを作成しました。ただし、Outlook 2013 に変更してから、スクリプトは機能しなくなりました。機能したスクリプトは次のとおりです。
Const olFolderInbox = 6
Set objOutlook = CreateObject("Outlook.Application") 'creates outlook application
Set objNamespace = objOutlook.GetNamespace("MAPI") 'sets the name space
Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox) 'finds the inbox
strFolderName = objInbox.Parent
Set objMailbox = objNamespace.Folders(strFolderName) 'sets the mailbox
Set objUnprocessed = objMailbox.Folders("Unprocessed Incoming Emails") 'sets one of the folders needed
Set objForwardFolder = objMailbox.Folders("Forwarded Emails") 'sets other folder needed
set objRegex = CreateObject("VBScript.RegExp") 'creates regex object
With objRegex
.Pattern = "^([a-z?-i]{1}([0-9]{3})([0-9]?)|[1][0][1-9]{2})$" 'first regex pattern to check
.Global = True
end With
set objReg = CreateObject("VBScript.RegExp") 'creates second regex object
With objReg
.Pattern = "([a-z?-i]{1}([0-9]{3})([0-9]?)|[1][0][1-9]{2})" 'second regex to check
.Global = True
end With
set objRegSlash = CreateObject("VBScript.RegExp") 'creates third regex object
With objRegSlash
.Pattern = "[\/]" 'used to change forwardslashes with spaces
.Global = True
end With
lngCount = objUnprocessed.Items.Count 'returns the count of the items in the Unprocessed Emails Folder
For j = lngCount To 1 Step - 1 'for every item do the following
matchingRef = "" 'used to return the reference in the email if matches
EmailCheckString = objUnprocessed.Items(j) 'returns the email subject line
if objReg.test(EmailCheckString) then 'if the subject line matches the first regex
set EmailCheckString = objUnprocessed.Items(j) 'sets the subject line again
if objRegSlash.test(EmailCheckString) then 'if the subject line contains forward slashes
EmailCheckString = Replace(EmailCheckString, "/", " ") 'replace with space
end if
EmailCheckString = Split(EmailCheckString, " ") 'splits the subject line into an array as of each word
for each word in EmailCheckString 'for each word in the array
if objRegex.test(word) then 'if word matches secondary regex
matchingRef = word 'matching ref is returns
exit for 'exit loop
end if
Next
if matchingRef <> "" then 'if the matching ref has been set
Set nameChange = objUnprocessed.Items(j)
nameChange.Subject = matchingRef 'changes the subject line to the reference
nameChange.Save 'saves item
objUnprocessed.Items(j).Move objInbox 'moves to the inbox
else
set autoForward = objUnprocessed.Items(j).Forward 'sets the email to forward
autoForward.Recipients.Add "name@domain.co.uk" 'adds email address
autoForward.Send 'sends
if objUnprocessed.Items(j).UnRead then 'if item is unread
objUnprocessed.Items(j).UnRead = false 'set to read
objUnprocessed.Items(j).Move objForwardFolder 'move to forwarded emails folder
else
objUnprocessed.Items(j).Move objForwardFolder 'move to forwarded emails folder
end if
end if
else
set autoForward = objUnprocessed.Items(j).Forward 'sets email to forward
autoForward.Recipients.Add "name@domain.co.uk" 'adds email address
autoForward.Send 'sends
if objUnprocessed.Items(j).UnRead then 'if the item is unread
objUnprocessed.Items(j).UnRead = false 'set to read
objUnprocessed.Items(j).Move objForwardFolder 'move to forwarded emails folder
else
objUnprocessed.Items(j).Move objForwardFolder 'move to forwarded emails folder
end if
end if
next
ただし、最初の EmailCheckString = objUnprocessed.Items(j) で壊れ、次のように表示されます: エラー: オブジェクトはこのプロパティまたはメソッドをサポートしていません: 'EmailCheckString' コード: 800A01B6
このスクリプトは、Outlook 2013 のアップグレードまでは問題なく機能していました。これを修正する方法について何か提案はありますか?