Why is my script not running automatically when outlook is started?

自古美人都是妖i 提交于 2021-01-29 14:26:22

问题


This script is in ThisOutlookSession and is only running if I change the functions to Public and run the function manually. I am using Outlook 365. This program scans for emails in an Inbox subfolder and when a new email comes in it downloads the attachment and sends it in an email to a different address. Why is it not running automatically and how do I fix it?

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 = "dse_na2@docusign.net") 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), Pos, 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 - 1) & " " & Mid(fileName(0), Pos)) & " / " & fileName(3)
        .To = "austin@stackoverflow.com"
        .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

来源:https://stackoverflow.com/questions/63404746/why-is-my-script-not-running-automatically-when-outlook-is-started

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!