Question

此代码对于正常的收件箱非常有效，但是如何从共享邮箱（xxx @ mail）更改代码以触发确认（仅适用于新邮件，需要排除“重新转发”邮件进入收件箱文件夹） .com）.folder（inbox）

如何修改此代码以从特定的共享邮箱“收件箱”触发

Public WithEvents xlItems As Outlook.Items
        Private Sub Application_Startup()
        Set xlItems = Session.GetDefaultFolder(olFolderInbox).Items
        End Sub

完整代码：

Public WithEvents xlItems As Outlook.Items
    Private Sub Application_Startup()
    Set xlItems = Session.GetDefaultFolder(olFolderInbox).Items
    End Sub
    Private Sub xlItems_ItemAdd(ByVal objItem As Object)
    Dim xlReply As MailItem
    Dim xStr As String
    If objItem.Class <> olMail Then Exit Sub
    Set xlReply = objItem.Reply
    With xlReply
         xStr = "<p>" & "Hi Team, Acknowledging that we have received the Job. Thank you!" & "</p>"
         .HTMLBody = xStr & .HTMLBody
         .Send
    End With
End Sub

我尝试了修改代码，但没有成功

Option Explicit
Private WithEvents olInboxItems As Items
  Dim objNS As NameSpace
  Set objNS = Application.Session
  ' instantiate objects declared WithEvents
  Set olInboxItems = objNS.Folders("xxxxxxxx@gmail.com").Folders("Inbox").Items
  Set objNS = Nothing
End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim xlReply As MailItem
Dim xStr As String
If objItem.Class <> olMail Then Exit Sub
Set xlReply = objItem.Reply
With xlReply
     xStr = "<p>" & "Hi Team, Acknowledging that we have received the Job. Thank you!" & "</p>"
     .HTMLBody = xStr & .HTMLBody
     .Send
End Sub

Answer 1

我终于自己弄清楚了代码。但是它会为所有电子邮件（包括RE和FWD）发送邮件

 <input type="button" onclick="nextFormPage(); window.scrollTo(0, 100)" 
    class="btn btn-danger btn-block" value="Next">

Answer 2

这是原始/直观的版本。
主题必须保持不变，并且为英文。

在ThisOutlookSession

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Public WithEvents olItems As Items

Private Sub Application_Startup()

    Dim objNS As namespace
    
    Set objNS = GetNamespace("MAPI")
    Set olItems = objNS.Folders("xxxx@xxx.com").Folders("Inbox").Items
    
End Sub

Private Sub olItems_ItemAdd(ByVal Item As Object)

    Dim olReply As MailItem
 
    If Item.Class = olMail Then
        
        If Left(UCase(Item.Subject), 4) = UCase("Re: ") Or _
           Left(UCase(Item.Subject), 4) = UCase("Fw: ") Then
            Exit Sub
        
        Else
        
            Set olReply = Item.reply
    
            With olReply
                .Body = "Reply to first email."
                .Display
            End With
        
        End If
    
    End If
    
End Sub

Answer 3

这应该比检查主题中的“ Re：”和“ Fw：”更健壮。

在ThisOutlookSession

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Public WithEvents olItems As Items

Private Sub Application_Startup()
    
    Set olItems = Session.Folders("xxxx@xxx.com").Folders("Inbox").Items
    
End Sub

Private Sub olItems_ItemAdd(ByVal Item As Object)

    Dim olReply As MailItem
 
    If Item.Class = olMail Then
        
        If Len(Item.ConversationIndex) > 44 Then
            Exit Sub
        
        Else
        
            Set olReply = Item.reply
    
            With olReply
                .Body = "Reply to first email."
                .Display
            End With
        
        End If
    
    End If
    
End Sub

如何为共享收件箱中的新邮件触发Outlook宏

3 个答案: