You are here:Home-Domande su Excel VBA e MACRO-Oggetto attività cerca trova sostituisci
Oggetto attività cerca trova sostituisci2022-08-08T10:44:18+02:00

Home Forum Domande su Excel VBA e MACRO Oggetto attività cerca trova sostituisci

Visualizzazione 2 filoni di risposte
  • Autore
    Post
    • Avatar1gator1
      Partecipante
        Post totali: 3

        Ciao a tutti !

         

        Ho trovato questa macro che cerca in tutta una cartella di attività tutte le attività con una specifica parola nell’oggetto e poi la sostituisce come un cerca trova sostituisci classico di excel.

         

        Option Explicit

        Sub FindReplaceTextsInAllTaskSubjects()

        Dim xPane As NavigationPane

        Dim xModule As TasksModule

        Dim xGroup As NavigationGroup

        Dim xNavFolder As NavigationFolder

        Dim xTaskItem As Outlook.TaskItem

        Dim i, k As Integer

        Dim xFindStr, xReplaceStr As String

        Dim xTotalCount As Long

        On Error Resume Next

        xFindStr = InputBox(“Type the words to find:”, “Kutools for Outlook”, xFindStr)

        If Len(Trim(xFindStr)) = 0 Then Exit Sub

        xReplaceStr = InputBox(“Type the words to replace:”, “Kutools for Outlook”, xReplaceStr)

        If Len(Trim(xReplaceStr)) = 0 Then Exit Sub

        xTotalCount = 0

        Set xPane = Outlook.Application.ActiveExplorer.NavigationPane

        Set xModule = xPane.Modules.GetNavigationModule(olModuleTasks)

        Set xGroup = xModule.NavigationGroups.Item(1)

        For i = xGroup.NavigationFolders.Count To 1 Step -1

        Set xNavFolder = xGroup.NavigationFolders.Item(i)

        For k = xNavFolder.Folder.Items.Count To 1 Step -1

        Set xTaskItem = xNavFolder.Folder.Items(k)

        If InStr(xTaskItem.Subject, xFindStr) > 0 Then

        xTaskItem.Subject = Replace(xTaskItem.Subject, xFindStr, xReplaceStr)

        xTaskItem.Save

        xTotalCount = xTotalCount + 1

        End If

        Next

        Next

        MsgBox xTotalCount & ” task subjects have been changed!”, vbInformation + vbOKOnly, “Kutools for Outlook”

        End Sub

         

         

         

         

        Ho due ordini di problemi ; il primo è la velocità di esecuzione … l’ho provata in una cartella con una sola attività e in una in cui ci sono 30 mila attività e la tempistica è uguale

         

        La seconda è che sembra esserci qualcosa che non va dato che nella cartella con una sola attività ha funzionato mentre in quella dove ce ne sono 30 mila ho fatto un paio di prove e non individua l’unica attività con la parola nell’oggetto da sostituire.

        Suggerimenti ?

        Stefano

         

        • Questo topic è stato modificato 1 mese, 3 settimane fa da Avatar1gator1.
      • Avatar1gator1
        Partecipante
          Post totali: 3

          Aggiornamento:

           

          Ho fatto prove aggiuntive e se cerco una parola anche se sono all’interno di una di queste cartelle mi sostituisce la parola chiave cercata in tutte le cartelle che ho https://filedropper.com/d/s/GCI4yTW35E12kqV8qBSQzX2DQ47noI)

          A questo punto ho bisogno che faccia il “cerca trova sostituisci” specificatamente nella cartella che sto visualizzando

          :scratch:

          • Questa risposta è stata modificata 1 mese, 3 settimane fa da Avatar1gator1.
          • Questa risposta è stata modificata 1 mese, 3 settimane fa da Avatar1gator1.
        • AvatarKris_9951
          Partecipante
            Post totali: 237

            Ciao 1gator1,

            prova questa macro.
            Per modificare la cartella che ti interessa ho inserito una inputbox dove gli scrivi il nome della cartella dal quale andranno fatte le modifiche (al momento non sono riuscito a dargli come riferimento la cartella che stai visualizzando in quel momento).

            Vedi se tutto va bene :bye:

            
            Option Explicit
            Option Compare Text
            
            Sub FindReplaceTextsInAllTaskSubjects()
            
                Dim xPane As NavigationPane
                Dim xModule As TasksModule
                Dim xGroup As NavigationGroup
                Dim xNavFolder As NavigationFolder
                Dim xTaskItem As Outlook.TaskItem
                Dim i, k As Long
                
                Dim xFindStr, xReplaceStr, nomeTask As String
                Dim xTotalCount As Long
                
                On Error Resume Next
                
                xFindStr = InputBox("Digita il testo da cercare:", "Testo da cercare", xFindStr)
                If Len(Trim(xFindStr)) = 0 Then Exit Sub
                
                xReplaceStr = InputBox("Didiga il testo da sostituire:", "Testo da sostituire", xReplaceStr)
                If Len(Trim(xReplaceStr)) = 0 Then Exit Sub
                
                nomeTask = InputBox("Digita il nome della cartella specifica dove vuoi sia fatta l'operazione:", "Nome della cartella", nomeTask)
                If Len(Trim(nomeTask)) = 0 Then Exit Sub
                
                xTotalCount = 0
                
                Set xPane = Outlook.Application.ActiveExplorer.NavigationPane
                Set xModule = xPane.Modules.GetNavigationModule(olModuleTasks)
                Set xGroup = xModule.NavigationGroups.Item(1)
                
                For i = xGroup.NavigationFolders.Count To 1 Step -1
                    If xGroup.NavigationFolders.Item(i).Folder.Name = nomeTask Then
                        Set xNavFolder = xGroup.NavigationFolders.Item(i)
                        
                        For k = xNavFolder.Folder.Items.Count To 1 Step -1
                            Set xTaskItem = xNavFolder.Folder.Items(k)
                            
                            If InStr(xTaskItem.Subject, xFindStr) > 0 Then
                                xTaskItem.Subject = Replace(xTaskItem.Subject, xFindStr, xReplaceStr)
                                xTaskItem.Save
                                xTotalCount = xTotalCount + 1
                            End If
                        Next
                        Exit For
                    End If
                Next
                
                MsgBox "Sono stati cambiati " & xTotalCount & " Tasks!", vbInformation + vbOKOnly, "Operazione conclusa"
            
            End Sub
        Visualizzazione 2 filoni di risposte
        • Devi essere connesso per rispondere a questo topic.