根据收到电子邮件的时间转发电子邮件

Question

我找到了一个关于使用 VBA 根据一天中收到电子邮件的时间转发电子邮件的参考资料。

我有一个客户希望在 X 和 Y 次之间将他们的电子邮件转发给下班后服务。我遵循了一些有关语法和操作的指南。

Private WithEvents objInboxItems As Outlook.Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
' instantiate Items collections for folders we want to monitor
Set objInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing

Debug.Print "Application_Startup occurred " & Now()

End Sub

Private Sub Application_Quit()
' disassociate global objects declared WithEvents
Set objInboxItems = Nothing
End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim olItems As Items, _
olItem As Object, _
olMailItem As MailItem, _
olAttachmentItem As Attachment, _
bolTimeMatch As Boolean
Set olItems = objInboxItems.Restrict("[Unread] = True")
For Each olItem In olItems
    If olItem.Class = olMail Then
        Set olMailItem = olItem
        'Change the times on the next line to those you want to use
        bolTimeMatch = (Time >= #3:00:00 PM#) And (Time <= #8:30:00 AM#)
        If bolTimeMatch Then
            Dim objMail As Outlook.MailItem
            Set objItem = olMailItem
            Set objMail = objItem.Forward
            'PUT THE EXTERNAL EMAIL ADDRESS YOU WANT TO USE ON THE NEXT LINE
            objMail.To = "email@email.com"
            objMail.Send
            Set objItem = Nothing
            Set objMail = Nothing
        End If
    End If
Next
End Sub

Function IsNothing(Obj)
If TypeName(Obj) = "Nothing" Then
    IsNothing = True
Else
    IsNothing = False
End If
End Function

我添加了调试打印以查看宏正在启动，并且我得到了肯定的输出，但实际上没有电子邮件触发转发。

这个用例是必需的，因为电子邮件被转发到转录服务，因此需要一个即发即忘的解决方案，而不是每天手动设置转发。

Answer 1

要转发电子邮件，您需要使用 Forward 方法，该方法对项目执行 Forward 操作，并 returns 将生成的副本作为 MailItem 对象。

Set myItem = mailItem.Forward
myItem.Send()

要查找特定时间段或日期的项目，您需要使用 Items class

的 Find/FindNext or Restrict 方法

How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder

使用以下代码作为搜索条件：

    Dim strFilter As String 
    Dim datStartUTC As Date 
    Dim datEndUTC As Date 

    datStartUTC = oPA.LocalTimeToUTC(Date) 
    datEndUTC = oPA.LocalTimeToUTC(DateAdd("d", 1, Date)) 

    'This filter uses urn:schemas:httpmail namespace 
    strFilter = AddQuotes("urn:schemas:httpmail:datereceived") _ 
    & " > '" & datStartUTC & "' AND " _ 
    & AddQuotes("urn:schemas:httpmail:datereceived") _ 
    & " < '" & datEndUTC & "'"

添加引号的辅助函数：

Public Function AddQuotes(ByVal SchemaName As String) As String 
    On Error Resume Next 
    AddQuotes = Chr(34) & SchemaName & Chr(34) 
End Function

Answer 2

我相信条件永远是假的。分成几部分。更容易调试。

要处理传入的项目，请将代码应用于 Private Sub objInboxItems_ItemAdd(ByVal Item As Object) 中的 Item。

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

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)

    Dim bolTimeMatch As Boolean
    Dim objMail As mailItem
    
    If Item.Class = olMail Then
        
        bolTimeMatch = (Time >= #3:00:00 PM#)
        
        If bolTimeMatch Then
            
            Set objMail = Item.Forward
            
            objMail.To = "email@email.com"
            objMail.Display    ' objMail.send
                    
        Else
        
            bolTimeMatch = (Time <= #8:30:00 AM#)
            
            If bolTimeMatch Then
            
                Set objMail = Item.Forward
                    
                objMail.To = "email@email.com"
                objMail.Display    ' objMail.send
            End If
                
        End If
        
    End If

End Sub

根据收到电子邮件的时间转发电子邮件

Forwarding email based on time email was received

events

outlook

vba