כיצד להעביר קבצים מצורפים אוטומטית על בסיס קריטריונים מסוימים ב-Outlook?

Author: Xiaoyang Last Modified: 2025-05-30

באופן רגיל, בעת העברת דואר אלקטרוני, גוף ההודעה המקורי והקבצים המצורפים נכללים גם כן. אך לפעמים, אתה זקוק רק להעברת הקבצים המצורפים ללא ההודעה המקורית בהתבסס על קריטריונים מסוימים לאדם מסוים. כיצד תוכל לפתור את המשימה הזו ב-Outlook?

העברת קבצים מצורפים בלבד על בסיס קריטריונים מסוימים לאדם באופן אוטומטי עם קוד VBA

העברת קבצים מצורפים בלבד על בסיס קריטריונים מסוימים לאדם באופן אוטומטי עם קוד VBA

לדוגמה, כאשר אתה מקבל דואר אלקטרוני שהנושא שלו מכיל את הטקסט 'kto feature', כל הקבצים המצורפים של דואר זה יועברו אוטומטית לאדם מסוים ללא הגוף של ההודעה המקורית. הצעדים הבאים יכולים לעזור לך, אנא עשה כך:

1. החזק את מקשי ALT + F11 כדי לפתוח את חלון Microsoft Visual Basic for Applications.

2. בחלון Microsoft Visual Basic for Applications, לחץ פעמיים על ThisOutlookSession מהחלונית Project1(VbaProject.OTM) כדי לפתוח את המצב, ולאחר מכן העתק והדבק את הקוד הבא לתוך המודול הריק.

קוד VBA: העברת דואר אלקטרוני אוטומטית ללא גוף ההודעה אלא כולל רק את הקבצים המצורפים:

Public WithEvents ReceivedItems As Outlook.Items
Private Sub Application_Startup()
    Set ReceivedItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub ReceivedItems_ItemAdd(ByVal Item As Object)
    Dim xForwardMail As Outlook.MailItem
    Dim xEmail As MailItem
    On Error Resume Next
    If Item.Class <> olMail Then Exit Sub
    Set xEmail = Item
    If InStrRev(UCase(xEmail.Subject), UCase("kto feature")) = 0 Then Exit Sub  'change subject text to your need
    If xEmail.Attachments.Count = 0 Then Exit Sub
    Set xForwardMail = xEmail.Forward
    With xForwardMail
        .HTMLBody = ""
        With .Recipients
            .Add "skyyang@addin88.com"    'change address to your own
            .ResolveAll
        End With
        .Send
    End With
End Sub

הערה: בקוד לעיל, עליך לשנות את טקסט הנושא ואת כתובת הנמען שלך.