Sviluppare funzionalita su Microsoft Office con VBA Contrassegna già letti i messaggi appartenenti ad una determinata categoria

LoginRegistrati
Stai vedendo 14 articoli - dal 1 a 14 (di 14 totali)
  • Autore
    Articoli
  • #16998 Risposta

    Cristian
    Partecipante

      Ciao a tutti, il mio codice funziona perfettamente e mi contrassegna come già letti tutti i messaggi appartenenti alla categoria "Servizio - Withdrawal completed" a patto che siano nel subfolder "Ritiri". Vorrei implementare il codice e fare in modo che mi contrassegni "già letti" tutti i messaggi appartenenti alla categoria "Servizio - Withdrawal completed", in tutti i folder e subfolder della posta in arrivo. Mi potreste aiutare per favore? 

      Sub MarkRead()
      'Contrassegna già letti i messaggi delle categorie specificate
       Dim myNamespace As Outlook.NameSpace
       Dim myInbox As Outlook.Folder
       
       Dim myItems As Outlook.Items
       Dim myItem As Object
      
       Set myNamespace = Application.GetNamespace("MAPI")
       Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox).Folders("Clienti").Folders("Ritiri")
       
       Set myItems = myInbox.Items
       Set myItem = myItems.Find("[Categories] = 'Servizio - Withdrawal completed'")
       While TypeName(myItem) <> "Nothing"
       
       'Contrassegna già letto
       myItem.UnRead = False
       myItem.Save
       
       Set myItem = myItems.FindNext
       Wend
       
      End Sub
      #17007 Risposta

      vecchio frac
      Senior Moderator
      • Sfida #1
        171 pts

        Una ricorsione. Purtroppo Restrict non funziona con le Categorie.

        Option Explicit
        
        Private Sub Main()
        Dim objNameSpace As Object
        Dim objMainFolder As Object
            
            Set objNameSpace = Application.GetNamespace("MAPI")
            Set objMainFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
            
            Call ProcessCurrentFolder(objMainFolder)
            MsgBox "Done"
        End Sub
         
        Private Sub ProcessCurrentFolder(ByVal objParentFolder As Outlook.MAPIFolder)
        Dim objCurFolder As Object
        Dim objMail As Object
        Dim myItems As Object, myItem As Object
            
            On Error Resume Next
            
            Set myItems = objParentFolder.Items
            
            For Each myItem In myItems
                If myItem.Categories Like "Servizio - Withdrawal completed" Then
                    'Contrassegna già letto
                    myItem.UnRead = False
                    myItem.Save
                    Set myItem = myItems.FindNext
                End If
            Next
                
            If (objParentFolder.Folders.Count > 0) Then
                For Each objCurFolder In objParentFolder.Folders
                    Call ProcessCurrentFolder(objCurFolder)
                Next
            End If
        End Sub
        
        #17008 Risposta

        Cristian
        Partecipante

          Non mi da errore, però purtroppo (nel mio caso) non funziona.   

          #17009 Risposta

          Cristian
          Partecipante

            Al momento ho implementato aggiungendo un altro folder (non so quante implementazioni dovrei fare in questo modo, perchè bene o male finiscono sempre negli stessi folder, però mi pare un codice troppo ripetitivo, come ho fatto io...)

            Sub MarkRead()
            'Contrassegna già letti i messaggi delle categorie specificate
             Dim myNamespace As Outlook.NameSpace
             Dim myInbox As Outlook.Folder
             
             Dim myItems As Outlook.Items
             Dim myItem As Object
            
            'Folder ritiri
             Set myNamespace = Application.GetNamespace("MAPI")
             Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox).Folders("Clienti").Folders("Ritiri")
             
             Set myItems = myInbox.Items
             Set myItem = myItems.Find("[Categories] = 'Servizio - Withdrawal completed'")
             While TypeName(myItem) <> "Nothing"
             
             'Contrassegna già letto
             myItem.UnRead = False
             myItem.Save
             
             Set myItem = myItems.FindNext
             Wend
             
             'Folder 250 Firenze - FIL
             
             Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox).Folders("Stef").Folders("250 Firenze - FIL")
             
             Set myItems = myInbox.Items
             Set myItem = myItems.Find("[Categories] = 'Servizio - Withdrawal completed'")
             While TypeName(myItem) <> "Nothing"
             
             'Contrassegna già letto
             myItem.UnRead = False
             myItem.Save
             
             Set myItem = myItems.FindNext
             Wend
             
            End Sub
            #17010 Risposta

            vecchio frac
            Senior Moderator
            • Sfida #1
              171 pts

              Cristian ha scritto:

              purtroppo (nel mio caso) non funziona.

              Che pizza 🙂

              Però a me dava fastidio non poter usare Restrict, così ho cercato bene e ho trovato il modo per implementare il filtro. Ti chiedo di fare la prova con questo codice:

              Option Explicit
              
              Private Sub Main()
              Dim objNameSpace As Object
              Dim objMainFolder As Object
                  
                  Set objNameSpace = Application.GetNamespace("MAPI")
                  Set objMainFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
                  
                  Call ProcessCurrentFolder(objMainFolder)
                  MsgBox "Done"
              End Sub
               
               
              Private Sub ProcessCurrentFolder(ByVal objParentFolder As Outlook.MAPIFolder)
              Dim objCurFolder As Object
              Dim objMail As Object
              Dim myItems As Object, myItem As Object
              Dim filt As String
              
                  On Error Resume Next
                  
                  filt = "@SQL=" & Chr(34) & "urn:schemas-microsoft-com:office:office#Keywords" & Chr(34) & " = 'Servizio - Withdrawal completed' "
               
                  Set myItems = objParentFolder.Items.Restrict(filt)
                  If myItems.Count > 0 Then
                     For Each myItem In myItems
                         If myItem.UnRead Then myItem.UnRead = False
                     Next
                  End If
                  
                  If (objParentFolder.Folders.Count > 0) Then
                      For Each objCurFolder In objParentFolder.Folders
                          Call ProcessCurrentFolder(objCurFolder)
                      Next
                  End If
              End Sub
              #17011 Risposta

              vecchio frac
              Senior Moderator
              • Sfida #1
                171 pts

                Cristian ha scritto:

                Non mi da errore

                Togli On Error Resume Next e vedi quindi in quale punto si ferma con l'errore.

                #17012 Risposta

                Cristian
                Partecipante

                  Straordinario!

                  Funziona perfettamente ed è velocissimo (praticamente immediato).

                  Grazie!

                  #17013 Risposta

                  vecchio frac
                  Senior Moderator
                  • Sfida #1
                    171 pts

                    Cristian ha scritto:

                    Funziona perfettamente

                    Uau, bella notizia anche per me! E' tutta la mattina che cerco e provo, poichè Restrict non funziona proprio con le Categorie e quindi cercavo una soluzione valida, e in più ho imparato una cosa nuova (il filtering con una stringa di connessione tipo SQL)   

                    #17020 Risposta

                    Cristian
                    Partecipante

                      Per due categorie ho modificato in questo modo e funziona perfettamente.

                      Vecchio Frac va bene secondo te, oppure potevo farla più breve?

                      Option Explicit
                      ' Contrassegna come già letti in tutti i subfolder i messaggi appartenenti alla categoria prescelta
                      Sub MarkReadCat()
                      Dim objNameSpace As Object
                      Dim objMainFolder As Object
                          
                          Set objNameSpace = Application.GetNamespace("MAPI")
                          Set objMainFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
                          
                          Call ProcessCurrentFolder(objMainFolder)
                          
                      End Sub
                       
                       
                      Private Sub ProcessCurrentFolder(ByVal objParentFolder As Outlook.MAPIFolder)
                      Dim objCurFolder As Object
                      Dim objMail As Object
                      Dim myItems As Object, myItem As Object
                      Dim filt As String
                      Dim filt2 As String
                      
                          On Error Resume Next
                          
                          'Servizio - Withdrawal completed
                          filt = "@SQL=" & Chr(34) & "urn:schemas-microsoft-com:office:office#Keywords" & Chr(34) & " = 'Servizio - Withdrawal completed' "
                       
                          Set myItems = objParentFolder.Items.Restrict(filt)
                          If myItems.count > 0 Then
                             For Each myItem In myItems
                                 If myItem.UnRead Then myItem.UnRead = False
                             Next
                          End If
                          
                          If (objParentFolder.Folders.count > 0) Then
                              For Each objCurFolder In objParentFolder.Folders
                                  Call ProcessCurrentFolder(objCurFolder)
                              Next
                          End If
                          
                          'Servizio - Activity completed
                          filt2 = "@SQL=" & Chr(34) & "urn:schemas-microsoft-com:office:office#Keywords" & Chr(34) & " = 'Servizio - Activity completed' "
                       
                          Set myItems = objParentFolder.Items.Restrict(filt2)
                          If myItems.count > 0 Then
                             For Each myItem In myItems
                                 If myItem.UnRead Then myItem.UnRead = False
                             Next
                          End If
                          
                          If (objParentFolder.Folders.count > 0) Then
                              For Each objCurFolder In objParentFolder.Folders
                                  Call ProcessCurrentFolder(objCurFolder)
                              Next
                          End If
                      End Sub
                      #17022 Risposta

                      vecchio frac
                      Senior Moderator
                      • Sfida #1
                        171 pts

                        Come vedi c'è lo stesso codice ripetuto più volte. Se dovessi applicare lo stesso concetto per 10 o 50 categorie, dovresti replicare il codice un uguale numero di volte: lavoro faticoso e inutile , con facilità di errori.

                        Potresti pensare a creare un piccolo ciclo Do ... Loop che maneggia i nomi delle categorie prelevandoli da un array, all'interno del ciclo c'è il codice ricorsivo.

                        Il succo è : scrivere una volta sola il codice necessario e richiamarlo solo quando serve, tutte le volte che serve.

                        #17032 Risposta

                        Cristian
                        Partecipante

                          Vecchio Frac, si ho compreso il concetto, ma non penso di essere in grado...

                          In ogni caso, per ora sono più che contento.

                          Se le categorie diventassero troppe dovrò necessariamente provarci, ma non saprei da dove iniziare.

                          #17033 Risposta

                          vecchio frac
                          Senior Moderator
                          • Sfida #1
                            171 pts

                            Cristian ha scritto:

                            non penso di essere in grado

                            Io non credo che sia così, appena riesco ti do lo spunto per provare. In ogni caso è meno difficile di quello che pensi 🙂

                            #17035 Risposta

                            vecchio frac
                            Senior Moderator
                            • Sfida #1
                              171 pts

                              Prova questo. In pratica il processo di scansione delle cartelle avviene dentro un ciclo For (potevi anche fare un ciclo Do Loop, non cambia niente), il quale preleva ogni singola categoria da un array; la modifica alla routine che processa le cartelle/sottocartelle accetta come parametro in ingresso il nome della categoria da esaminare. I nomi dei parametri sono identici ma ciò non crea confusione perchè la visibilità di una variabile è (se non specificato diversamente) locale all'interno della routine in cui è dichiarata.

                              Option Explicit
                              
                              Private Sub Main()
                              Dim objNameSpace As Object
                              Dim objMainFolder As Object
                              Dim category As Variant
                                  
                                  Set objNameSpace = Application.GetNamespace("MAPI")
                                  Set objMainFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
                                  
                                  For Each category In Array("Servizio - Withdrawal completed", "Servizio - Activity completed")
                                      Call ProcessCurrentFolder(objMainFolder, CStr(category))
                                  Next
                                  MsgBox "Done"
                              End Sub
                               
                               
                              Private Sub ProcessCurrentFolder(ByVal objParentFolder As Outlook.MAPIFolder, category As String)
                              Dim objCurFolder As Object
                              Dim objMail As Object
                              Dim myItems As Object, myItem As Object
                              Dim filt As String
                              
                                     filt = "@SQL=" & Chr(34) & "urn:schemas-microsoft-com:office:office#Keywords" & Chr(34) & " = '" & category & "' "
                                  
                                     Set myItems = objParentFolder.Items.Restrict(filt)
                                     If myItems.Count > 0 Then
                                        For Each myItem In myItems
                                            If myItem.UnRead Then myItem.UnRead = False
                                        Next
                                     End If
                                     
                                     If (objParentFolder.Folders.Count > 0) Then
                                         For Each objCurFolder In objParentFolder.Folders
                                             Call ProcessCurrentFolder(objCurFolder, category)
                                         Next
                                     End If
                              End Sub
                              #17040 Risposta

                              Cristian
                              Partecipante

                                Non ho parole per ringraziarti.

                                Funziona perfettamente!

                              LoginRegistrati
                              Stai vedendo 14 articoli - dal 1 a 14 (di 14 totali)
                              Rispondi a: Contrassegna già letti i messaggi appartenenti ad una determinata categoria
                              Gli allegati sono permessi solo ad utenti REGISTRATI
                              Le tue informazioni:



                              vecchio frac - 2748 risposte

                              albatros54
                              albatros54 - 731 risposte

                              patel
                              patel - 634 risposte

                              Marius44
                              Marius44 - 557 risposte

                              Luca73
                              Luca73 - 523 risposte