为什么启动Outlook后我的脚本没有自动运行？

问题描述

此脚本位于ThisOutlookSession中，仅当我将功能更改为“公共”并手动运行该功能时，该脚本才会运行。我使用的是Outlook365。此程序扫描“收件箱”子文件夹中的电子邮件，并在收到新电子邮件时下载附件并将其通过电子邮件发送到其他地址。为什么它不自动运行以及如何解决？

Option Explicit
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim Inbox  As Outlook.MAPIFolder
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    
    Dim Sub_folder  As Outlook.MAPIFolder
    Set Sub_folder = Inbox.Folders("DocuSign")
    
    Set Items = Sub_folder.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)

On Error GoTo ErrorHandler
    'Only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    If TypeName(Item) = "MailItem" Then
        Set Msg = Item
    'Filter
        If (Msg.SenderEmailAddress = "[email protected]") And _
        (InStr(Msg.Subject,"Completed:")) And _
        (Msg.Attachments.Count >= 1) Then
    
    Dim olDestFldr As Outlook.MAPIFolder
    Dim myAttachments As Outlook.Attachments
    Dim attPath As String
    Dim Att As String
    Dim fileName() As String
    Dim suffix As String
    Dim Pos As Integer
    Dim payrollEmail As Outlook.MailItem
    
    
   Set myAttachments = Item.Attachments
    Att = myAttachments.Item(1).DisplayName
    ' remove .pdf
    Att = Left(Att,InStrRev(Att,".") - 1)
    fileName = Split(Att,"_")
    
    ' set location to save in.  Can be root drive or mapped network drive.
    If (UBound(fileName) - LBound(fileName) + 1) = 5 Then
        attPath = "\\austin_network_share\"
        suffix = "_Returned.pdf"
    Else
        attPath = "\\austin_network_share2\"
        suffix = "_Signed.pdf"
    End If
    ' save attachment to folder
    If Dir(attPath,vbDirectory) = "" Then
        MsgBox attPath & " does not exist."
        Err.Raise vbObjectError
    End If
    myAttachments.Item(1).SaveAsFile attPath & Att & suffix
    
    ' email payroll
    Pos = 2
    While (Asc(Mid(fileName(0),Pos,1)) < 65 Or (Asc(Mid(fileName(0),1)) > 90))
        Pos = Pos + 1
    Wend
    
    Set payrollEmail = Application.CreateItem(olMailItem)
    With payrollEmail
        .BodyFormat = olFormatHTML
        .Subject = "Equipment Licensing Agreement for " & (Left(fileName(0),Pos - 1) & " " & Mid(fileName(0),Pos)) & " / " & fileName(3)
        .HTMLBody = "Attached is ELA for " & (Left(fileName(0),Pos)) & " / " & fileName(3)
        .To = "[email protected]"
        .Attachments.Add (attPath & Att & suffix)
        .Send
    End With
    
        
    ' mark as read and delete
   Msg.UnRead = False
   'Msg.Delete
End If
End If
    

ProgramExit:
  Exit Sub
  
ErrorHandler:
  MsgBox "ELA SCRIPT ERROR: " & Err.Number & " - " & Err.Description & ": " & Msg.Subject
  Resume ProgramExit
End Sub

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）