Outlook: Formulár pre vyhľadanie prílohy v emailoch

Publikoval Michal Kočí dňa 24.3.2005 o 23:07 v kategórii Office

Microsoft Office Outllok je fajn. Je príjemné, že ak nejakú feature nemá, dá sa celkom ľahko doprogramovať pomocou VBA. No a keďže docela často sa mi v poslednej dobe stávalo, že som potreboval vyhľadať email podľa názvu prílohy a toto sa v štandardnom vyhľadávacom dialógu nedá, musel som si to doprogramovať sám. S výsledkom som samozrejme nanajvýš spokojný :)

Mal som zopár požiadaviek a všetky sa mi podarilo naimplementovať:

  • vyhľadávať sa musí dať podľa časti názvu prílohy
  • vyhľadávať sa bude default v priečinku, v ktorom som nastavený, ale bude sa dať vybrať aj iný priečinok
  • vyhľadávanie sa bude dať prerušiť
  • bude sa zobrazovať priebeh hľadania
  • ak jeden mail obsahuje viac príloh, ktorích názvy obsahujú hľadaný text, mail sa v zozname zobrazý len raz
  • vo výsledkoch uvidím odosielateľa, predmet a dátum prijatia správy

Hneď na začiatku upozorňujem prípadných čitateľov, že používam (navyše používam svojskú) maďarskú notáciu, testovaniu kódu som nevenoval toľko času, koľko by si zaslúžil a v neposlednom rade som kód neoptimalizoval (ak je to u VBA vôbec možné) :)

Teda aby som nenapínal, formulár na vyhľadanie vyzerá nasledovne:

Formulár bude mať zopár globálnych premenných, nesúcich informácie o nájdených emailoch, či prebieha hľadanie, či je požiadavka na stornovanie hľadania, v akom priečinku sa má hľadať atď

Dim mailsFounded() As MailItem
Dim nsThis As NameSpace
Dim fldrSelected As MAPIFolder
Dim bCanceled As Boolean
Dim bSearching As Boolean

Pri aktivácii formulára je potrebné spraviť niekoľko základných úkonov, najmä zistiť aktuálny priečinok, pripraviť stĺpce v zozname s mailami, ktoré obsahujú hľadané prílohy.

Private Sub UserForm_Activate()

    Set nsThis = Application.GetNamespace("MAPI")
    Set fldrSelected = Application.ActiveExplorer.CurrentFolder
    tbFolder.Text = fldrSelected
    lvResults.ColumnHeaders.Add , , "Od", 100
    lvResults.ColumnHeaders.Add , , "Predmet", 150
    lvResults.ColumnHeaders.Add , , "Dátum", 100
    
    bSearching = False
    bCanceled = False

End Sub

Pri požiadavke na výber iného priečinka sa musí užívateľovi zobraziť dialóg na výber priečinka a v prípade, že si niektorý vyberie a voľbu potvrdí, nastaví sa globálna premenná na zvolený priečinok.

Private Sub btnSelectFolder_Click()

    Dim fldrTemp As MAPIFolder
    Set fldrTemp = nsThis.PickFolder
    
    If Not (fldrTemp Is Nothing) Then
    
        Set fldrSelected = fldrTemp
        tbFolder.Text = fldrSelected
        
    End If

End Sub

Vyhľadávacia procedúra je najdlhšia ale nie zložitá. Keďže jedno tlačidlo má slúžiť na hľadanie aj na ukončenie hľadania, je potrebné hneď na začiatku skontrolovať, či už hľadanie nebeží. Ak nie, nastaví sa príznak, že hľadanie beží a zmení sa text tlačidla. Ak beží, nastaví sa príznak, že treba stornovať hľadanie a procedúra sa ukončí.

Ďalej sa pripraví progress bar, ktorý bude zobrazovať priebeh hľadania a v “stavovom riadku” sa zobrazí informácia o začatí hľadania.

Nasleduje cyklus, ktorý skontroluje každú položku v prehľadávanom priečinku. Prvý krok cyklu kontroluje, či nebola požiadavka na ukončenie hľadania a ak bola, potom hľadanie zastaví (ukončí sa procedúra), predtým však trochu prečistí formulár. U práve kontrolovanej položky sa zistí, či sa jedná o e-mail a ak áno, či obsahuje prílohy. Ak prílohy obsahuje, každú z nich skontroluje, či sa v jej názve nenachádza hľadaný text. Ak áno, nastaví sa príznak, že sa mail má email pridať do výsledkov.

Ak niektorá príloha mailu vyhovela hľadanému názvu, do zoznamu výsledných mailov sa vloží nová položka obsahujúca odosielateľa, predmet správy a dátum prijatia. Zároveň sa do globálnej premennej pridá odkaz na tento email, aby keď si užívateľ bude chciet mail zobraziť, nemusel prehľadať znovu celý priečinok.

Na konci hľadania sa opäť prečistí formulár a do stavového riadku sa vypíše oznam o ukončení hľadania.

Private Sub btnSearch_Click()
    
    Dim mailOne As MailItem
    Dim objectOne As Object
    Dim attOne As Attachment
    Dim bFound As Boolean
    Dim lPosition As Long
    Dim liOne As ListItem
    
    If Not bSearching Then
        
        bSearching = True
        bCanceled = False
        btnSearch.Caption = "Zrušiť"
        
    Else
    
        bCanceled = True
        btnSearch.Caption = "Hľadať"
        
        Exit Sub
    
    End If
    
    ReDim mailsFounded(0)
    lvResults.ListItems.Clear
    lblInfo.Caption = "Hľadá sa príloha obsahujúca v názve " & tbFileName.Text
    
    pbProgress.Min = 0
    pbProgress.Max = fldrSelected.Items.Count
    pbProgress.Value = 0
    
    For Each objectOne In fldrSelected.Items
    
        If bCanceled Then
        
            pbProgress.Value = 0
        
            bSearching = False
            Exit Sub
        
        End If
    
        pbProgress.Value = pbProgress.Value + 1
    
        If objectOne.Class = olMail Then
        
            DoEvents
            
            Set mailOne = objectOne
            bFound = False
            
            If (mailOne.Attachments.Count > 0) Then
            
                For Each attOne In mailOne.Attachments
                
                    If (InStr(1, attOne.FileName, _
                    tbFileName.Text, vbTextCompare) > 0) _
                    Then
                    
                        bFound = True
                    
                    End If
                    
                Next
            
            End If
            
            If bFound Then
            
                ReDim Preserve mailsFounded(UBound(mailsFounded) + 1)
                Set mailsFounded(UBound(mailsFounded)) = mailOne
                    
                Set liOne = lvResults.ListItems.Add
                liOne.Text = mailOne.SenderName
                liOne.SubItems(1) = mailOne.Subject
                liOne.SubItems(2) = mailOne.ReceivedTime
            
            End If
        
        End If
        
    Next
    
    lblInfo.Caption = "Koniec hľadania"
    btnSearch.Caption = "Hľadať"
    
End Sub

Pri požiadavke na zobrazenie vybraného emailu sa skontroluje, či je nejaký email vybraný a ak áno, potom sa otvorí.

Private Sub btnOpenMessage_Click()

    Dim mailSelected As MailItem
    Dim liSelected As ListItem
    
    If Not (lvResults.SelectedItem Is Nothing) Then
    
        Set mailSelected = mailsFounded(lvResults.SelectedItem.Index)
        mailSelected.Display
    
    End If

End Sub

Keď bol formulár hotový (a pár minút testovaný), tak som si do toolbaru pridal ikonku, ktorá mi formulár pustí. To je celkom jednoduché, stačí si pripraviť pomocnú verejnú procedúru, ktorá formulár zobrazí a tú volať z tlačidla, ktoré si do toolbaru pridáte.

Sub ShowFindEmailDialog()

    frmFindAttachments.Show

End Sub

Jednoduché, nie? Ak si chcete stiahnuť tento formulár, urobte tak...

Mohlo by ťa tiež zaujímať

Páčil sa ti príspevok?

Zdieľaj príspevok alebo si ho odlož na neskôr

Sleduj ma

Ak nechceš premeškať príspevky ako je tento, sleduj ma na Twitteri, alebo ak máš RSS čítačku, môžeš sledovať môj RSS kanál.

Kategórie

Archív

Školenia a kurzy

Audioknihy

Podcasty