VBATools

Przenoszenie wiadomości do innego folderu z warunkami

by on Sep.30, 2010, under Outlook, Porady

Jeden z angielskojęzycznych forumowiczów spytał czy jest możliwość utworzenia reguły dla poczty przychodzącej, która by przenosiła wiadomości z określonymi parametrami. Głównie chodziło o przeniesienie starszych wiadomości o określonej dacie, z folderu „Skrzynka odbiorcza” do zdefiniowanego.

Poniżej znajduje się makro, które można wywołać z poziomu przycisku i działa dla każdego folderu, w którym zostanie wywołane. Opcjonalnie oprócz spełnionych wymagań dodano adres rozpoznanie adresu nadawcy, którego proces miałby dotyczyć.

Poniższą funkcje sterującą procesem można rozszerzyć o wymaganie załączników, konkretnej treści zawartej w temacie lub kontekście treści wiadomości, bądź dodając wizualną stronę taką jak pasek postępu osadzony w formie.

Option Explicit

Sub MoveMess2Folder()
'opcjonalne można umieścić adres wysyłającego lub/i datę ograniczenia czasu utworzenia wiadomości
    Call MoveToFolder("VBATools", "vbatools@vbatools.pl", Now - 365)
End Sub

Function MoveToFolder(DestFolderName$, Optional MassageFrom$, Optional CreationTime As Date)
    'MVP OShon from VBATools.pl
    Dim myOLApp As Application
    Dim myNameSpace As NameSpace
    Dim myInbox As MAPIFolder
    Dim objItem As MailItem
    Dim x&
    Dim oFolder As MAPIFolder
    Dim IoTask As Items

    If Application.ActiveExplorer.CurrentFolder.DefaultItemType <> 0 Then Exit Function
    Set myOLApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOLApp.GetNamespace("MAPI")
    Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
    Set IoTask = myInbox.Items
    Set oFolder = myOLApp.ActiveExplorer.CurrentFolder

    If Not FolderExists(myInbox, DestFolderName) Then
       MsgBox "Folder ''" & DestFolderName & "'' does not exist under ''" & myInbox & "'' folder" & _
           vbCr & "Create the folder ''" & DestFolderName & "'' or change VBACode.", vbExclamation, "VBATools.pl"
      Exit Function
   End If

    For x = IoTask.Count To 1 Step -1
    DoEvents
        'W tym miejscu można pobrać i dodać wartość parametru do paska postępu
        If IoTask.item(x).Class = 43 Then
            Set objItem = IoTask.item(x)
            'Debug.Print objItem.SenderEmailAddress & " " & objItem.Subject
            If Len(CreationTime) > 0 And Len(MassageFrom) > 0 Then
                If objItem.SenderEmailAddress = MassageFrom And _
                Format(objItem.CreationTime, "Short Date") <= Format(CreationTime, "Short Date") Then _
                objItem.Move (myInbox.Folders(DestFolderName))
            ElseIf Len(MassageFrom) > 0 And Len(CreationTime) = 0 Then
                If objItem.SenderEmailAddress = MassageFrom Then _
                objItem.Move (myInbox.Folders(DestFolderName))
            ElseIf Len(CreationTime) > 0 And Len(MassageFrom) = 0 Then
                If Format(objItem.CreationTime, "Short Date") <= Format(CreationTime, "Short Date") Then _
                objItem.Move (myInbox.Folders(DestFolderName))
            Else
                objItem.Move (myInbox.Folders(DestFolderName))
            End If
        End If
    Next

    Set objItem = Nothing
    Set oFolder = Nothing
    Set IoTask = Nothing
    Set myOLApp = Nothing
    Set myNameSpace = Nothing
    Set myInbox = Nothing
    Set objItem = Nothing
End Function

Function FolderExists(parentFolder As MAPIFolder, DestFolderName As String)
    'Function code from www.outlookcode.com
    Dim tmpInbox As MAPIFolder
    On Error GoTo handleError
    Set tmpInbox = parentFolder.Folders(DestFolderName)
    FolderExists = True
    Exit Function
handleError:
    FolderExists = False
End Function

Jeśli nie ma się doświadczenia w instalacji makr polecam przeczytać artykuł Instalacja i uruchamianie makr.

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.

Jeden z angielskojęzycznych forumowiczów spytał czy jest możliwość utworzenia reguły dla poczty przychodzącej, która by przenosiła wiadomości z określonymi parametrami. Głównie chodziło o przeniesienie starszych wiadomości o określonej dacie, z folderu „Skrzynka odbiorcza” do zdefiniowanego.Poniżej znajduje się makro, które można wywołać z poziomu przycisku i działa dla każdego folderu, w którym zostanie wywołane. Opcjonalnie oprócz spełnionych wymagań dodano adres rozpoznanie adresu nadawcy, którego proces miałby dotyczyć.Poniższą funkcje sterującą procesem można rozszerzyć o wymaganie załączników, konkretnej treści zawartej w temacie lub kontekście treści wiadomości, bądź dodając wizualną stronę taką jak pasek postępu osadzony w formie.

Jeden z angielskojęzycznych forumowiczów spytał czy jest możliwość utworzenia reguły dla poczty przychodzącej, która by przenosiła wiadomości z określonymi parametrami. Głównie chodziło o przeniesienie starszych wiadomości o określonej dacie, z folderu „Skrzynka odbiorcza” do zdefiniowanego.

Poniżej znajduje się makro, które można wywołać z poziomu przycisku i działa dla każdego folderu, w którym zostanie wywołane. Opcjonalnie oprócz spełnionych wymagań dodano adres rozpoznanie adresu nadawcy, którego proces miałby dotyczyć.

Poniższą funkcje sterującą procesem można rozszerzyć o wymaganie załączników, konkretnej treści zawartej w temacie lub kontekście treści wiadomości, bądź dodając wizualną stronę taką jak pasek postępu osadzony w formie.

:, ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Joanna Subik
Profile picture of Karol Stilger
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała