Option Explicit

' Listing 11.1.
' Procedura, ktra wyszczeglnia foldery pierwszego i 
' drugiego poziomu przestrzeni nazw Outlooka
'
Sub ListFolders()
    Dim ns As NameSpace
    Dim folder As MAPIFolder
    Dim subfolder As MAPIFolder
         
         Konfigurowanie przestrzeni nazw
        
   Set ns = ThisOutlookSession.Session
       
        Przetworzenie folderw pierwszego poziomu
       
   For Each folder In ns.Folders
       Debug.Print folder.Name
                 
                  Przetworzenie folderw drugiego poziomu (jeli konieczne)
                
       If folder.Folders.Count > 1 Then
          For Each subfolder In folder.Folders
              Debug.Print     & subfolder.Name
          Next subfolder
       End If
   Next folder
   Set ns = Nothing
End Sub

'
' Listing 11.2.
' Procedura testujca metod PickFolder
'
Sub PickFolderTest()
    Dim ns As NameSpace
    Dim folder As MAPIFolder
        
         Skonfigurowanie przestrzeni nazw
        
   Set ns = ThisOutlookSession.Session
       
        Wywietlenie okna dialogowego Wybierz folder
       
   Set folder = ns.PickFolder
       
        Testowanie zwrconej wartoci
       
   If Not folder Is Nothing Then 
       MsgBox Wybrano folder  & folder.Name
   End If
End Sub

'
' Listing 11.3.
' Procedury obsugi zdarze Startup i Quit Outlooka
'
' UWAGA: Kod ten naley skopiowa do obiektu ThisOutlookSession
'
Private Sub Application_Startup()
         
          Skonfigurowanie przestrzeni nazw
         
    Set ns = ThisOutlookSession.Session
         
          Uzyskanie obiektu folderu Wysane elementy
         
    Set inboxItems = ns.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Application_Quit()
         
         Usunicie obiektw w celu zaoszczdzenia pamici
        
    Set inboxItems = Nothing
    Set ns = Nothing
End Sub

'
' Listing 11.5.
' Procedura obsugi zdarzenia ItemSend, ktra pyta uytkownika, czy w folderze 
' Wysane elementy chce umieci kopi wysanej wiadomoci
'
' UWAGA: Kod ten naley skopiowa do obiektu ThisOutlookSession
'
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
   Dim nResult As Integer
       
        Wywietlenie pytania
       
   nResult = MsgBox(Czy zapisa t wiadomo w folderze Wysane elementy?, vbSystemModal + vbYesNoCancel)
      
       Sprawdzenie wyniku
      
   If nResult = vbCancel Then
       Cancel = True
   End If

   If nResult = vbNo Then
                 
                 Jeli uytkownik klikn przycisk Nie, wiadomo nie ma by zapisywana w folderze Wysane elementy
                
      Item.DeleteAfterSubmit = True
   End If
End Sub

'
' 
'
' Listing 11.6.
' Procedura obsugi zdarzenia ItemAdd, ktre stosuje niestandardowe reguy
'
' UWAGA: Kod ten naley skopiowa do obiektu ThisOutlookSession
'
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
   Dim topFolder As MAPIFolder
   Dim ruleFolder As MAPIFolder
       
        Zapisanie folderu Foldery osobiste
       
   Set topFolder = ns.Folders(Foldery osobiste)
       
        Niestandardowa regua #1
        Przenie wiadomoci z adresem nadawcy president@whitehouse.gov 
        LUB zawierajce w treci sowo polityka
       
   If Item.SenderEmailAddress = president@whitehouse.gov _ 
      Or InStr(Item.Body, polityka) <> 0 Then
       Set ruleFolder = topFolder.Folders(Polityka)
       Item.Move ruleFolder
   End If
       
        Niestandardowa regua #2
       Oznaczy wiadomoci z acuchami Konferencja I 2007 w temacie
      
   If InStr(Item.Subject, Konferencja) <> 0 _
    And InStr(Item.Subject, 2007) <> 0 Then
     Item.FlagStatus = olFlagMarked
     Item.FlagRequest = Review
     Item.FlagIcon = olBlueFlagIcon
     Item.FlagDueBy = Now() + 7
     Item.Save
   End If
End Sub

'
' Listing 11.7.
' Procedura obsugi zdarzenia ItemAdd, ktra przenosi wiadomoci-mieci
'
' UWAGA: Kod ten naley skopiowa do obiektu ThisOutlookSession
'
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    Dim att As Attachment
         
          Czy wiadomo ma zaczniki?
         
    If Item.Attachments.Count > 0 Then
                  
                  Jeli tak, ptla sprawdzi kady zacznik
                 
       For Each att In Item.Attachments

                          
                           Czy jest to plik graficzny z rozszerzeniem .gif?
                          
           If InStr(att.FileName, .gif) <> 0 Then
                                   
                                    Jeli tak, wiadomo zostanie przeniesiona do folderu Wiadomoci-mieci
                                   
               Debug.Print Przeniesienie wiadomoci  & Item.Subject & 
               Item.Move ns.GetDefaultFolder(olFolderJunk)
           End If
       Next att
    End If
End Sub

'
' Listing 11.8.
' Procedura wysyajca wiadomo pocztow
'
Sub SendAMessage()
    Dim ns As NameSpace
    Dim msg As MailItem
         
          Skonfigurowanie przestrzeni nazw
         
    Set ns = ThisOutlookSession.Session
         
          Utworzenie nowego obiektu MailItem
         
    Set msg = Application.CreateItem(olMailItem)
         
          Okrelenie odbiorcy, tematu i treci wiadomoci, a nastpnie
          wysanie jej
        
    With msg
                    
                     Trzeba zmodyfikowa poniszy adres!
                    
        .Recipients.Add bla@bla.com
        .Subject = Tylko testowanie
        .Body = To tylko test
        .Send
    End With
End Sub

'
' Listing 11.9.
' Procedura wysyajca wiadomo pocztow, gdy Outlook zacznie tworzy przypomnienie
'
' UWAGA: Kod ten naley skopiowa do obiektu ThisOutlookSession
'
Private Sub Application_Reminder(ByVal Item As Object)
   Dim msg As MailItem
       
        Utworzenie nowej wiadomoci
       
   Set msg = Application.CreateItem(olMailItem)
       
        Okrelenie dla wiadomoci adresu i tematu przypomnienia
       
   msg.To = twj_adres@cokolwiek.com
   msg.Subject = Item.Subject
   msg.Body = Przypomnienie! & vbCrLf & vbCrLf
       
        Okrelenie treci wiadomoci przy uyciu waciwoci
        odpowiednich dla rnych typw przypomnie
       
   Select Case Item.Class
     Case olAppointment
         msg.Body = Przypomnienie o spotkaniu! & vbCrLf & vbCrLf & _
         Pocztek:  & Item.Start & vbCrLf & _
         Koniec:  & Item.End & vbCrLf & _
         Miejsce:  & Item.Location & vbCrLf & _
         Szczegy spotkania:  & vbCrLf & Item.Body
     Case olContact
         msg.Body = Przypomnienie dotyczce kontaktu! & vbCrLf & vbCrLf & _
         Kontakt:  & Item.FullName & vbCrLf & _
         Firma:  & Item.CompanyName & vbCrLf & _
         Telefon:  & Item.BusinessTelephoneNumber & vbCrLf & _
         E-mail:  & Item.Email1Address & vbCrLf & _
         Szczegy dotyczce kontaktu:  & vbCrLf & Item.Body
     Case olMail
         msg.Body = Przypomnienie o wiadomoci! & vbCrLf & vbCrLf & _
         Nadawca:  & Item.SenderName & vbCrLf & _
         E-mail:  & Item.SenderEmailAddress & vbCrLf & _
         Wane do:  & Item.FlagDueBy & vbCrLf & _
         Flaga:  & Item.FlagRequest & vbCrLf & _
         Tre wiadomoci:  & vbCrLf & Item.Body
     Case olTask
         msg.Body = Przypomnienie o zadaniu! & vbCrLf & vbCrLf & _
         Wane do:  & Item.DueDate & vbCrLf & _
         Status:  & Item.Status & vbCrLf & _
         Szczegy zadania:  & vbCrLf & Item.Body
   End Select
       
        Wysanie wiadomoci
       
   msg.Send
       
        Zwolnienie obiektu msg
      
   Set msg = Nothing
End Sub

'
' Listing 11.10.
' Procedura tworzca wiadomo przesyan dalej i przed wysaniem usuwajca z niej 
' wszystkie istniejce zaczniki
'
Sub ForwardAndDeleteAttachments()
    Dim insp As Inspector
    Dim msg As MailItem
    Dim att As Attachment
         
          Przywrcenie okna otwartej wiadomoci
         
    Set insp = Application.ActiveInspector
         
          Sprawdzenie, czy okno wiadomoci jest aktywne
         
    If insp Is Nothing Then Exit Sub
          
           Utworzenie wiadomoci przesyanej dalej
          
    Set msg = insp.CurrentItem.Forward
    With msg
                   
                    Usuwanie wszystkich zacznikw
                  
       For Each att in .Attachments
           att.Delete
       Next att
                
                 Wywietlenie wiadomoci
               
       .Display
    End With
End Sub

