Outlook 规则不会 运行 脚本,除非手动 运行

Outlook Rule will not run script unless manually ran

每当我将我的脚本添加到我在 Outlook 中设置的规则时,它会将我的规则设置为仅客户端。该规则用于获取主题行中的特定词和正文中的特定词,然后将电子邮件移动到收件箱的子文件夹,然后 运行 一个脚本。当前规则 运行s 当我通过将电子邮件移动到定向文件夹来接收电子邮件但脚本不会 运行 除非我现在手动单击规则 运行。我怎样才能让它到达仅在服务器端处理的位置,这样我就不必手动 运行 规则到 运行 脚本。下面是我的脚本:

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)上。

服务器端规则仅适用于一组有限的操作。主要是那些简单的动作,比如移动物品、回复等。 任何比这更复杂的东西都会成为 client-only 规则。在 运行 是脚本的规则的情况下,那些将始终是 client-only 规则,因为脚本实际上是 Outlook 的一部分并由 Outlook 执行,而不是邮件服务器。因此,即使规则存储在您的邮箱中,执行也是如此,它需要 Outlook 来执行操作的某些部分。 当您完成规则制定后,您会在规则向导的最后一页上看到它是否是 client-only 规则。

服务器端规则的唯一选项,使用脚本或服务器级别的某些代码作为传输规则或传输代理。

我建议您将操作分成两部分,一部分是 server-side 规则,一部分是 运行 有或没有 Outlook,然后是您可以 运行 "on-demand" 做更复杂的位。它不是完全自动化的,但至少你可以将项目移动到某个临时文件夹并且不碍事。