Hogyan lehet automatikusan elküldeni az elküldött értekezleteket az Outlook egy adott mappájába?

Normális esetben az e-mailek vagy értekezletek elküldése után mindkettő az Elküldött elemek mappába kerül. Tehát az Elküldött elemek mappa jelentősen rendetlen és nehézkes lesz. Ez a cikk bemutat egy módszert az elküldött értekezletek automatikus áthelyezésére egy másik mappába az értekezlet kiküldése után.

Az elküldött értekezleteket automatikusan áthelyezi egy VBA kóddal ellátott mappába

Az elküldött értekezleteket automatikusan áthelyezi egy VBA kóddal ellátott mappába

Az összes elküldött értekezlet-meghívó automatikus áthelyezéséhez egy másik mappába a következő kód segíthet, kérjük, tegye a következőket:

1. Tartsa lenyomva a ALT + F11 billentyűk megnyitásához Microsoft Visual Basic for Applications ablak.

2. Az Microsoft Visual Basic for Applications ablakban kattintson duplán ThisOutlookSession tól Project1 (VbaProject.OTM) ablaktáblán nyissa meg a módot, majd másolja és illessze be a következő kódot az üres modulba.

VBA kód: Az elküldött értekezletek automatikus áthelyezése egy adott mappába

Private WithEvents GExplorer As Outlook.Explorer
Public WithEvents GSentFolder As Outlook.Folder
Public WithEvents GSentItems As Outlook.Items
Private Sub Application_Startup()
    Set GExplorer = Outlook.Application.ActiveExplorer
End Sub
Private Sub GExplorer_SelectionChange()
Dim xFolder As Folder, xRootFolder As Folder
Dim xRootFldName As String
Dim xPos As Integer
    On Error Resume Next
    Set xFolder = Outlook.Application.ActiveExplorer.CurrentFolder
    xPos = VBA.InStr(3, xFolder.FolderPath, "\")
    If xPos > 0 Then
        xRootFldName = VBA.Mid(xFolder.FolderPath, 3, xPos - 3)
    Else
        xRootFldName = VBA.Mid(xFolder.FolderPath, 3, Len(xFolder.FolderPath) - 2)
    End If
    Set xRootFolder = Outlook.Application.Session.Folders(xRootFldName)
    Set GSentFolder = xRootFolder.Folders("Sent Items")
    Set GSentItems = GSentFolder.Items
End Sub
Private Sub GSentItems_ItemAdd(ByVal Item As Object)
    Dim xMeetingItem As Outlook.MeetingItem
    Dim xTargetFolder As Outlook.Folder
    On Error Resume Next
    If Item.Class <> olMeetingRequest Then Exit Sub
    Set xMeetingItem = Item
    Set xTargetFolder = GSentFolder.Folders("Meetings")
    If xTargetFolder Is Nothing Then
        Set xTargetFolder = GSentFolder.Folders.Add("Meetings")
    End If
    xMeetingItem.Move xTargetFolder
End Sub

doc lépés küldött értekezlet 1

3. Ezután mentse el és zárja be a kódablakot. Most, amikor egy értekezletről szóló e-mailt elküldünk, az egy új mappába kerül találkozók alatt a Elküldött elemek mappa automatikusan, lásd a képernyőképet:

doc lépés küldött értekezlet 2