问题
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