☰

如何使用 VBA 将新电子邮件转发给下一位团队成员？

tag-icon • tag-icon microsoft-outlook vba
如何使用 VBA 将新电子邮件转发给下一位团队成员？

我管理着一个销售团队，我们会在团队收件箱中收到推荐。我手动将每个新推荐转发给我的团队成员，这非常浪费时间。

我希望将每封新的推荐电子邮件转发给下一位团队成员。

接收新电子邮件 - 发送给团队成员 1
接收新电子邮件 - 发送给团队成员 2
接收新电子邮件 - 发送给团队成员 3

接收新电子邮件 - 发送给团队成员 1
接收新电子邮件 - 发送给团队成员 2
接收新电子邮件 - 发送给团队成员 3

等等。

答案1

目前还没有发现有基于消息接收顺序的脚本，如果网络拥堵，接收顺序可能不正常，从而导致问题。

为什么不在这些不同的电子邮件消息之间添加一些特定的“标记”，然后本文中的“在邮件正文中查找代码，然后转发”的部分可能会对您有所帮助。https://www.slipstick.com/outlook/rules/run-script-rule-change-subject-message/

答案2

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

' Convert to ItemAdd code to do this automatically

' Avoid global variables unless there is no other way
'  Inevitably the name will be non-unique
'  You need something improbable to reproduce in other code
Public nextEmp20210216 As Long  ' starts at 0 when Outlook opens, unless last value saved

Private Sub AssignMail()

Dim myFolder As folder
Dim myFolderItem As Object  ' not necessarily a mailitem

Dim myFolderItems As Items
Dim myFolderItemsCount As Long

Dim myFilteredItems As Items
Dim myFilteredItemsCount As Long

Dim i As Long
Dim myMail As MailItem
Dim forwardMail As MailItem

Dim empArray() As String    ' zero-based array

' rotate elements if no code to equitably assign the first mail
empArray = Split("[email protected],[email protected],[email protected]", ",")

For i = LBound(empArray) To UBound(empArray)
    Debug.Print i & ": " & empArray(i)
Next i

Debug.Print "UBound(empArray): " & UBound(empArray)

'RetrieveStorageData
' https://docs.microsoft.com/en-us/office/vba/api/outlook.folder.getstorage
' Could instead use a text file, or Excel workbook, or ...

Debug.Print " starting nextEmp20210216: " & nextEmp20210216

If nextEmp20210216 > UBound(empArray) Then
    ' can occur if array elements reduced since last run
    nextEmp20210216 = 0
End If

Set myFolder = Session.GetDefaultFolder(olFolderInbox)
'Set myFolder = myFolder.folders("Test")

Set myFolderItems = myFolder.Items

myFolderItems.Sort "[ReceivedTime]"

myFolderItemsCount = myFolderItems.count
Debug.Print " myFolderItemsCount..: " & myFolderItemsCount

' Simple method to stop repeats.
Set myFilteredItems = myFolder.Items.Restrict("[UnRead] = True")
myFilteredItemsCount = myFilteredItems.count
Debug.Print " myFilteredItemsCount: " & myFilteredItemsCount

For i = myFilteredItemsCount To 1 Step -1

    If TypeOf myFilteredItems(i) Is MailItem Then
        
        Set myMail = myFilteredItems(i)
        Set forwardMail = myMail.Forward
        
        With forwardMail
            Debug.Print .subject
            Debug.Print " current nextEmp20210216: " & nextEmp20210216
            .To = empArray(nextEmp20210216)
            Debug.Print "  " & .To
            
            ' Resolve recipients if not using email addresses.
            '  Never fails with email address format - [email protected].
            '.Recipients.ResolveAll
            
            .Display    ' change to .send
        End With
        
        With myMail
        
            ' Simple method to stop repeats
            .UnRead = False
            
            ' If necessary, for better evidence mail was assigned with this code
            
            ' 1 - Since this is a reverse For Loop
            '     can move myMail to "Assigned" folder
            
            ' Or
            
            ' 2 - Mark, perhaps with a category
            '.categories = "Green Category"
            '.Save   ' required when updating categories
            
        End With
        
        nextEmp20210216 = (nextEmp20210216 + 1) Mod (UBound(empArray) + 1)
        Debug.Print " future  nextEmp20210216: " & nextEmp20210216
        
    End If
    
Next

'AssignStorageData
' https://docs.microsoft.com/en-us/office/vba/api/outlook.folder.getstorage

End Sub

相关内容