此代码非常适合普通收件箱，但如何更改代码以触发共享邮箱（[电子邮件受保护]）的确认（仅适用于新邮件，需要排除收件箱文件夹中的重新和转发邮件） ）.文件夹（收件箱）
如何修改此代码以从特定共享邮箱“收件箱”触发
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("[email protected]").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
这应该比检查主题中的“Re:”和“Fw:”更可靠。
在本次展望会议中
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("[email protected]").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
我终于自己想出了代码。但它会发送所有电子邮件，包括（RE 和 FWD）
Public WithEvents olItems As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set olItems = objNS.Folders("[email protected]").Folders("Inbox").Items
End Sub
Private Sub olItems_ItemAdd(ByVal Item As Object)
Dim olReply As MailItem
If Item.Class = olMail Then
Set olReply = Item.Reply
Else
Exit Sub
End If
With olReply
'Type Your Own Auto Reply
'Change "John Smith" to Your Own Name
.Body = "This is a test auto reply." & vbCrLf & vbCrLf & "-------Original Message-------" & vbCrLf & "From: " & Item.Sender & "[mailto: " & Item.SenderEmailAddress & "]" & vbCrLf & "Sent: " & Item.ReceivedTime & vbCrLf & "To: YourName" & vbCrLf & "Subject: " & Item.Subject & vbCrLf & Item.Body
.Send
End With
End Sub
这是原始/直观的版本。
主题必须保持不变且为英文。
在本次展望会议中
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("[email protected]").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
我得到了这个代码，可以在共享邮箱上使用。当收到新电子邮件时，它会显示一个消息框，其中包含新电子邮件的主题行。只需将变量名称“共享邮箱名称”更新为共享收件箱的名称（我认为还有另一种方法可以输入实际的电子邮件地址）。
**注意：此代码位于 ThisOutlookSession 部分，而不是模块。
Private WithEvents sharedInboxItems As Outlook.Items
Private Sub Application_Startup()
Dim sharedInbox As Outlook.Folder
Dim sharedMailboxName As String
'****************************************************
'Name of the shared mailbox
sharedMailboxName = "Shared Mailbox Name"
'****************************************************
'Get shared inbox folder
Set sharedInbox = Application.GetNamespace("MAPI").Folders(sharedMailboxName).Folders("Inbox")
'Set sharedInboxItems variable to the items in the shared inbox
Set sharedInboxItems = sharedInbox.Items
End Sub
Private Sub sharedInboxItems_ItemAdd(ByVal Item As Object)
'****************************************************************
'Apply your logic below:
'Display a message box with the subject of the new email
MsgBox "You have a new email!! Subject: " & Item.Subject
'****************************************************************
End Sub