Question

我在Outlook中有许多“脚本”模块已被禁用，因为我们的系统中已删除“运行为脚本”选项。

活动项目的“Run as Script”文件处理示例：

Public Sub saveAVMAttachtoDisk(itm As Outlook.MailItem)

'Prepare variables
Dim objAtt As Outlook.Attachment

'Identify destination folders:
'Engineering AVM Daily Fault folder is as follows:
    '\\Dc3fap002\Transit Engineering\Reliability MDBF\AVM\Daily Reports\
Dim saveFolder1 As String
    saveFolder1 = "\\Dc3fap002\groups$\Transit Engineering\Reliability MDBF\AVM\Daily Reports\"

'Engineering AVM Oil Pressure Analysis folder is as follows:
    '\\Dc3fap002\Transit Engineering\Reliability MDBF\AVM\Daily Reports\
Dim saveFolder2 As String
    saveFolder2 = "\\Dc3fap002\groups$\Transit Engineering\Project Management\Fluid Life Oil Analysis\AVM Oil Pressure Study\AVM Data\"

Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd H-mm")

'Save file
     For Each objAtt In itm.Attachments
     'Saves each Daily Fault Summary Report
          If InStr(objAtt.DisplayName, "OC Transpo - Daily Fault Summary Report") Then
               objAtt.SaveAsFile saveFolder1 & "\" & objAtt.DisplayName
          End If

      'Saves each Oil Pressure File with the date and time (to prevent overwriting)
          If InStr(objAtt.DisplayName, "Engine Oil Pressure") Then
           objAtt.SaveAsFile saveFolder2 & "\" & dateFormat & " " & objAtt.DisplayName
          End If

      'Clears the Attachment for the purposes of the loop
          Set objAtt = Nothing
     Next

End Sub

我已经尝试了以下NewMailItem检测代码，但我正在将数据加载到错误的文件夹中，当我上线一次试用时（我没有安装所有安全和错误处理代码）时，我意外删除/覆盖了一些）。这是来自https://www.slipstick.com/developer/processing-incoming-e-mails-with-macros/

的未经调整的原始代码

我认为这就是我需要的，我只需要在调试脚本中对其进行操作（调用另一个例程）而不是“回显”。

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objNewMailItems As Outlook.Items

Private Sub Application_Startup()

Dim objMyInbox As Outlook.MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
Set objMyInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objNewMailItems = objMyInbox.Items
Set objMyInbox = Nothing
End Sub


Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)
'Ensure we are only working with e-mail items
If Item.Class <> olMail Then Exit Sub

Debug.Print "Message subject: " & Item; .Subject
Debug.Print "Message sender: " & Item; .SenderName & " (" & Item; .SenderEmailAddress & ")";
End Sub

Answer 1

运行中的脚本代码是ItemAdd代码中的项目。

以下三条建议都是等效的。

建议1 - 重复使用原样运行脚本代码。

Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)
    'Ensure we are only working with e-mail items
    If Item.Class <> olMail Then Exit Sub

    saveAVMAttachtoDisk item

End Sub

建议2 - 将itm设置为等于item，因此包含的运行中没有更改脚本代码。

Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)

    'Ensure we are only working with e-mail items
    If Item.Class <> olMail Then Exit Sub

    dim itm as mailitem
    set itm = item

    'Prepare variables
    Dim objAtt As Outlook.Attachment

    'Identify destination folders:
    'Engineering AVM Daily Fault folder is as follows:
    '\\Dc3fap002\Transit Engineering\Reliability MDBF\AVM\Daily Reports\
    Dim saveFolder1 As String
    saveFolder1 = "\\Dc3fap002\groups$\Transit Engineering\Reliability MDBF\AVM\Daily Reports\"

    'Engineering AVM Oil Pressure Analysis folder is as follows:
    '\\Dc3fap002\Transit Engineering\Reliability MDBF\AVM\Daily Reports\
    Dim saveFolder2 As String
    saveFolder2 = "\\Dc3fap002\groups$\Transit Engineering\Project Management\Fluid Life Oil Analysis\AVM Oil Pressure Study\AVM Data\"

    Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd H-mm")

    'Save file
    For Each objAtt In itm.Attachments
        'Saves each Daily Fault Summary Report
        If InStr(objAtt.DisplayName, "OC Transpo - Daily Fault Summary Report") Then
            objAtt.SaveAsFile saveFolder1 & "\" & objAtt.DisplayName
        End If

        'Saves each Oil Pressure File with the date and time (to prevent overwriting)
        If InStr(objAtt.DisplayName, "Engine Oil Pressure") Then
            objAtt.SaveAsFile saveFolder2 & "\" & dateFormat & " " & objAtt.DisplayName
        End If

        'Clears the Attachment for the purposes of the loop
        Set objAtt = Nothing
    Next

End Sub

建议3 - 用项目

替换itm的实例

Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)

'Ensure we are only working with e-mail items
If Item.Class <> olMail Then Exit Sub

'Prepare variables
Dim objAtt As Outlook.Attachment

'Identify destination folders:
'Engineering AVM Daily Fault folder is as follows:
'\\Dc3fap002\Transit Engineering\Reliability MDBF\AVM\Daily Reports\
Dim saveFolder1 As String
saveFolder1 = "\\Dc3fap002\groups$\Transit Engineering\Reliability MDBF\AVM\Daily Reports\"

'Engineering AVM Oil Pressure Analysis folder is as follows:
'\\Dc3fap002\Transit Engineering\Reliability MDBF\AVM\Daily Reports\
Dim saveFolder2 As String
saveFolder2 = "\\Dc3fap002\groups$\Transit Engineering\Project Management\Fluid Life Oil Analysis\AVM Oil Pressure Study\AVM Data\"

Dim dateFormat
dateFormat = Format(item.ReceivedTime, "yyyy-mm-dd H-mm")

'Save file
For Each objAtt In item.Attachments
    'Saves each Daily Fault Summary Report
    If InStr(objAtt.DisplayName, "OC Transpo - Daily Fault Summary Report") Then
        objAtt.SaveAsFile saveFolder1 & "\" & objAtt.DisplayName
    End If

    'Saves each Oil Pressure File with the date and time (to prevent overwriting)
    If InStr(objAtt.DisplayName, "Engine Oil Pressure") Then
        objAtt.SaveAsFile saveFolder2 & "\" & dateFormat & " " & objAtt.DisplayName
    End If

    'Clears the Attachment for the purposes of the loop
    Set objAtt = Nothing
Next

End Sub

如何替换Outlook 2016规则中的“作为脚本运行”功能？

1 个答案: