Vbscript 除非手动运行,否则Outlook规则不会运行脚本
每当我将脚本添加到outlook中设置的规则时,它都会将我的规则设置为仅客户端。该规则用于获取主题行中的特定单词和正文中的特定单词,然后将电子邮件移动到收件箱的子文件夹,然后运行脚本。当前规则在我通过将电子邮件移动到定向文件夹接收电子邮件时运行,但脚本不会运行,除非我手动单击要立即运行的规则。我如何使它只在服务器端处理,这样我就不必手动运行规则来运行脚本。下面是我的脚本:Vbscript 除非手动运行,否则Outlook规则不会运行脚本,vbscript,outlook-2013,Vbscript,Outlook 2013,每当我将脚本添加到outlook中设置的规则时,它都会将我的规则设置为仅客户端。该规则用于获取主题行中的特定单词和正文中的特定单词,然后将电子邮件移动到收件箱的子文件夹,然后运行脚本。当前规则在我通过将电子邮件移动到定向文件夹接收电子邮件时运行,但脚本不会运行,除非我手动单击要立即运行的规则。我如何使它只在服务器端处理,这样我就不必手动运行规则来运行脚本。下面是我的脚本: Public Sub Application_NewMail(myMail As MailItem) Dim con As
Public Sub Application_NewMail(myMail As MailItem)
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim dbName As String
dbName = "M:\CRM\Custom CRM\CRM.accdb"
Set con = New ADODB.Connection
con.ConnectionString = _
"Provider = Microsoft.ACE.OLEDB.12.0; " & _
"Data Source = " & dbName & "; " & _
"Persist Security Info = False; " & _
"Mode = readwrite;"
con.Open
' Create 2 recordset objects for data manipulation throughout the project
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.ActiveConnection = con
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
End With
Dim ns As Outlook.NameSpace
Dim InBoxFolder As MAPIFolder
Dim InBoxItem As Object 'MailItem
Dim Contents As String, Delimiter As String
Dim Prop, Result
Dim i As Long, j As Long, k As Long
Dim myOlApp As Object
Set myOlApp = CreateObject("Outlook.Application")
'Setup an array with all properties that can be found in the mail
Prop = Array("Name", "Email", "Phone", "I am an")
'The delimiter after the property
Delimiter = ":"
Set ns = Session.Application.GetNamespace("MAPI")
'Access the inbox folder
Set InBoxFolder = ns.GetDefaultFolder(olFolderInbox)
Set InBoxFolder = InBoxFolder.Folders("MBAA LEADS")
For Each InBoxItem In InBoxFolder.Items
'Only process mails
If Not TypeOf InBoxItem Is MailItem Then GoTo SkipItem
'Already processed?
If Not InBoxItem.UnRead Then GoTo SkipItem
'Mark as read
InBoxItem.UnRead = False
'Get the body
Contents = InBoxItem.Body
'Create space for the result
ReDim Result(LBound(Prop) To UBound(Prop)) As String
'Search each property
i = 1
rs.Open ("Prospects")
rs.AddNew
For k = LBound(Prop) To UBound(Prop)
'MsgBox k
'Find the property (after the last position)
i = InStr(i, Contents, Prop(k), vbTextCompare)
If i = 0 Then GoTo NextProp
'Find the delimiter after the property
i = InStr(i, Contents, Delimiter)
If i = 0 Then GoTo NextProp
'Find the end of this line
j = InStr(i, Contents, vbCr)
If j = 0 Then GoTo NextProp
'Store the related part
Result(k) = Trim$(Mid$(Contents, i + Len(Delimiter), j - i - Len(Delimiter)))
If (k = 0) Then
'First Name
rs![First Name] = StrConv(Trim(Mid(CStr(Result(k)), 1, InStr(CStr(Result(k)), " "))), vbProperCase)
'Last Name
rs![Last Name] = StrConv(Trim(Mid(CStr(Result(k)), InStrRev(CStr(Result(k)), " ") + 1)), vbProperCase)
MkDir ("M:\CRM\PROSPECTS\" & StrConv(Trim(Mid(CStr(Result(k)), 1, InStr(CStr(Result(k)), " "))), vbProperCase) & " " & StrConv(Trim(Mid(CStr(Result(k)), InStrRev(CStr(Result(k)), " ") + 1)), vbProperCase) & "")
'Copy Initial Email Inquiry
InBoxItem.SaveAs "M:\CRM\PROSPECTS\" & StrConv(Trim(Mid(CStr(Result(k)), 1, InStr(CStr(Result(k)), " "))), vbProperCase) & " " & StrConv(Trim(Mid(CStr(Result(k)), InStrRev(CStr(Result(k)), " ") + 1)), vbProperCase) & "\Initial Email-MBAA WEBSITE.msg"
ElseIf (k = 1) Then
rs![E-mail Address] = Trim(Mid(CStr(Result(k)), 1, InStr(CStr(Result(k)), " ")))
ElseIf (k = 2) Then
rs![Home Phone] = Result(k)
ElseIf (k = 3) Then
'Check customer type
If CStr(Result(k)) Like "*Self Insured Group*" Then
rs![Lead Type] = 1 'Self Insured Group
ElseIf CStr(Result(k)) Like "*Insurance Company*" Then
rs![Lead Type] = 2 'Insurance Company
ElseIf CStr(Result(k)) Like "*Individual Patient*" Then
rs![Lead Type] = 3 'Consumer
ElseIf CStr(Result(k)) Like "*Attorney*" Then
rs![Lead Type] = 4 'Attorney
ElseIf CStr(Result(k)) Like "*Government*" Then
rs![Lead Type] = 5 'Attorney
ElseIf CStr(Result(k)) Like "*Physician*" Then
rs![Lead Type] = 6 'Physician
ElseIf CStr(Result(k)) Like "*International Company*" Then
rs![Lead Type] = 7 'International Company
ElseIf CStr(Result(k)) Like "*Broker*" Then
rs![Lead Type] = 8 'Broker
ElseIf CStr(Result(k)) Like "*Association/Organization*" Then
rs![Lead Type] = 19 'Association/Organization
ElseIf CStr(Result(k)) Like "*Other*" Then
rs![Lead Type] = 9 'Other
End If
End If
NextProp:
Next
rs![CreatedOn] = InBoxItem.SentOn
rs![Source] = 13 'MBAA WEBSITE
rs.Update
rs.Close
SkipItem:
Next
con.Close
End Sub
我将假定您的邮箱位于Exchange服务器或Office365(也是Exchange)上 服务器端规则仅适用于有限的一组操作。主要是那些简单的动作,比如移动物品、回复等等。 任何比这更复杂的事情都会成为客户专用的规则。对于运行脚本的规则,这些规则将始终是仅限客户端的规则,因为脚本实际上是Outlook的一部分,并由Outlook执行,而不是邮件服务器。因此,即使规则存储在您的邮箱中,执行过程也需要Outlook处理操作的某些部分。 您将看到,当您完成制定规则时,在规则向导的最后一页,它将指示该规则是否为仅限客户端的规则 服务器端规则的唯一选项是使用脚本,或服务器级别的某些代码(如传输规则或传输代理) 我建议您将操作分为两个部分,一个是服务器端规则,在有Outlook或没有Outlook的情况下运行,然后是一个规则,您可以运行“按需”来完成更复杂的部分。它不是完全自动化的,但至少你可以将项目移动到某个临时文件夹中,并且不碍事