Rispondere a delle mail tramite VBA di Excell

[EnricoBanco]

Grazie mille!!! Provo!!!
Ciao

[EnricoBanco]

Ciao,
seguito un test con varie casistiche.
Funziona e alcune osservazioni.
Andando dall'alto verso il basso nel folder DaProcessare,
se per esempio si selezionano su tre e-mail la prima e la terza, apre la seconda e la terza.
Sembra che salta la prima e-mail andando dall'alto verso il basso.

Se per esempio ci sono sei e-mail nel folder DaProcessare e si evidenziano dall'alto verso il basso la prima, la quarta e la sesta, elabora la prima e poi si blocca.
Se per esempio ci sono sei e-mail nel folder DaProcessare e si evidenziano dal basso verso l'alto la sesta, la quarta e la prima elabora la sesta e poi si blocca.

Strano è come se quando trova "un salto e-mail" non riesce a completare il processo.

Se si selezionano la quarta e la quinta completa il processo quindi sembra che voglia e-mail adiacenti.

Ho provato ad agire all'interno del ciclo "J" sui numeri 0, 1 e -1 ma il risultato non cambia.

Sembra che il punto interessante sia il "salto e-mail". Cioè non sembra che non riesca a contare l'e-mail non selezionata tra due selezionate e si o apre la successiva o si blocca dando il messaggio di "fuori intervallo".

Ciao e ancora grazie

[EnricoBanco]

Cioè volevo dire che sembra che il punto interessante sia il "salto e-mail". Cioè sembra che non riesca a contare l'e-mail non selezionata tra due e-mail selezionate e quindi apre quella centrale (non selezionata) e la terza oppure si blocca se la selezione prevede due salti e-mail elaborando solo la prima in ordine di selezione.

Ciao e grazie ancora

[EnricoBanco]

Dimenticavo il processo inoltre funziona in questo modo:
- selezionando e-mail adiacenti;
- sull'e-mail aperta manualmente. In caso di più e-mail aperte il processo agisce sull'ultima in ordine di apertura

[Anthony47]

Niente, bisogna fare due gestioni diverse per il caso Inspector e il caso Explorer...
Estraiamo la parte comune e inseriamola in una nuova Sub:

Codice: Seleziona tutto

Sub myPROC(ByRef myMex As MailItem, ByVal SJadd As String, ByVal MAILtxt As String, ByRef proCd As MAPIFolder)
        Set myReply = myMex.ReplyAll
        myReply.Subject = myMex.Subject & SJadd
        myReply.Body = MAILtxt & myReply.Body
    '    myReply.Send
        myReply.Display
        myWait (0.3)
        myMex.Move proCd
        myWait (0.2)
End Sub


Modifichiamo la Sub RepSel come segue:

Codice: Seleziona tutto

Sub RepSel2()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=107024&p=638054#p638054
Dim daProc As MAPIFolder, proCd As MAPIFolder
Dim myNameSpace As NameSpace, myMex As MailItem, myReply As MailItem
Dim SJadd As String, MAILtxt As String, I As Long
'
SJadd = " - autoanswer by macro"                    '<<< Un testo da accodare nel Subject
'Composizione del testo della Risposta (esempio):   '<<< Composizione del testo
MAILtxt = "Cari amici, sapete gia' che fare " & vbCrLf
MAILtxt = MAILtxt & "Firmato: Enrico" & vbCrLf
MAILtxt = MAILtxt & "Non telefonatemi" & vbCrLf
'
Set myNameSpace = Application.GetNamespace("MAPI")
'Set daProc = myNameSpace.Folders("Cartelle personali").Folders("Posta in arrivo").Folders("DaProcessare")   '<<<Folder di origine
Set proCd = myNameSpace.Folders("Cartelle personali").Folders("Posta in arrivo").Folders("Processate")      '<<< Folder si destinazione
'
Dim sMail As Single

Select Case TypeName(Application.ActiveWindow)
   Case "Explorer"
        sMail = Application.ActiveExplorer.Selection.Count
   Case "Inspector"
        sMail = 0.1
   Case Else
End Select
'
If sMail >= 1 Then
    For Each myMex In Application.ActiveExplorer.Selection
        If TypeOf myMex Is MailItem Then
            Call myPROC(myMex, SJadd, MAILtxt, proCd)
            I = I + 1
        End If
    Next myMex
ElseIf sMail > 0 Then
    Set myMex = Application.ActiveInspector.CurrentItem
    If TypeOf myMex Is MailItem Then
        Call myPROC(myMex, SJadd, MAILtxt, proCd)
        I = I + 1
    End If
End If
On Error Resume Next
myMex.Close olDiscard
Application.ActiveInspector.Close olDiscard
On Error GoTo 0
MsgBox ("Completato; (" & I & " messaggi)")
End Sub


La Sub myWait rimane sempre col codice originale.

La macro da avviare e' la Sub RepSel2

Ciao

keywords
Outlook automation Risposta automatica alle mail selezionate selezionata Invio messaggio standard
Reply standard message to selected emails

[EnricoBanco]

Ciao Anthony, grazie mille veramente.
Dopo alcuni giorni di test...La tua RepSel2() funziona!!!
Inserita anche icona alla toolbar alla quale viene agganciata RepSel2 che funziona perfettamente con il "myReply.Send". Quindi si possono inserire varie icone per gestire il tipo di send, folder, ecc..
Strano ma se invece resta attivo il display l'unica e-mail selezionata o l'ultima di n non la lavora, la copia solo nel folder "Processate".
Ma la modalità "send" funziona benissimo. Perfetta!!! Del resto se sono "DaProcessare" vuol dire che vanno inviate ;o)

La macro Sub RepAll2 di Anthony che invece funziona anche in excel con la modifica della riga indicata nel codice fulviot a inizio post:
Set myNameSpace = Outlook.GetNamespace("MAPI") 'modificata solo questa riga (della macro vba Outlook: Set myNameSpace = Application.GetNamespace("MAPI")) e e che apre tutte le e-mail del folder "DaProcessare" è anche molto utile perchè se si mettono in una tabella tre colonne (in prima riga le descrizione e dalla seconda riga i valori) : |Codice regola|Folder|Testo e-mail| si può creare un tool prendendo spunto dal codice di fulviot in cui setta il testo e-mail da un foglio excel. Il tool excel quindi seleziona da una combobox il codice regola (create in Outlook) e con una formula cerca.vert si seleziona il testo e-mail e poi si fa partire la/le e-mail relative a quel folder. Per il cerca.vert ho utilizzato la seguente formula:

Codice: Seleziona tutto

=SE(F7="";"";CERCA.VERT(F7;A2:C12;3;FALSO))

In F7 viene settato il codice regola dal LikedCell della combobox preso da A2:A13 ed il cerca vert restituisce in F10 il testo e-mail che sta in colonna 3 cioè la C. Certo se aumentano le righe occorre cambiare la formula cerca.vert e il ListFillRange del combobox.

Esempio di combinazione codice fulviot e Anthony per settare il testo nell'e-mail

Codice: Seleziona tutto

risposta_Select = Foglio1.Cells(10, 6).Value
MAILtxt = Foglio1.Cells(10, 6).Value
myReply.Body = MAILtxt & myReply.Body

A ogni regola si possono far corrispondere tre pulsanti d'invio e-mail per reply, replayall e forward. Quindi è utile per controllare i flussi di e-mail che partono e con quale modalità. Prima dell'invio il display consente di verificarle.

Scartabellando ho provato ad inserire anche un file in allegato e ripetendo il codice varie volte si possono allegare più file cambiando i riferimenti delle Dim. Ovviamente va messo prima di myReply.Send o myReply.Display

Codice: Seleziona tutto

'Allega il primo file: file.doc
Dim MyFileName As String
Dim MyFileAttacments As String
MyFileName = "file.doc"

MyFileAttacments = "C:\miadirectory\" & MyFileName & ""
       
       With myReply
        .Attachments.Add MyFileAttacments
        End With


'Allega il secondo: file.xls
Dim MyFileNameOriginale As String
Dim MyFileAttacmentsOriginale As String
MyFileNameOriginale = "File.xls"

MyFileAttacmentsOriginale = "C:\miadirectory\" & MyFileNameOriginale & ""
       
       With myReply
        .Attachments.Add MyFileAttacmentsOriginale
        End With

Scopiazzando nel web ho inserito anche un form con tre pagine per la gestione del data entry delle tre colonne |Codice regola|Folder|Testo e-mail|. Ciascun delle quali ha i corrispondenti campi textbox e le tre label di descrizione. E' possibile nel foglio "Nuovo" inserire record, nel foglio "Modifica" aggiornare record, nel foglio "Visualizza" mostrare e cancellare record. Per aggiornare il campo testo e-mail e folder si utilizza il check box. Ecco tutto il codice:

Codice: Seleziona tutto

Option Explicit
Dim y As Integer
Dim blnTrovato As Boolean
Dim I As Integer
Dim blnCancella As Boolean
Dim intRisposta As Integer
Dim blnAggiorna As Boolean
Dim x As Integer






Private Sub chkFolder_Click()
    ' attivo e disattivo la casella di testo txtFolder2 al clic sulla rispettiva checkbox
    If chkFolder.Value = True Then
        txtFolder2.Enabled = True
        lblFolder2.Enabled = True
    Else
        txtFolder2.Enabled = False
        lblFolder2.Enabled = False
    End If
End Sub





Private Sub chkTestoEmail_Click()
    ' attivo e disattivo la casella di testo txtTestoEmail2 al clic sulla rispettiva checkbox
    If chkTestoEmail.Value = True Then
        txtTestoEmail2.Enabled = True
        lblTestoEmail2.Enabled = True
    Else
        txtTestoEmail2.Enabled = False
        lblTestoEmail2.Enabled = False
    End If
End Sub




Private Sub cmdAggiornaCodice_Click()
   
    ' controllo che non siano dati vuoti e che i dati siano del TestoEmail che mi serve
    If txtFolder2.Text = "" Then
        MsgBox "Attenzione! Visualizza i dati prima della modifica!"
        txtFolder2.Enabled = True
        txtFolder2.SetFocus
        Exit Sub
    ElseIf IsNumeric(txtFolder2.Text) Then
        MsgBox "Attenzione! Specifica un Folder"
        txtFolder2.Enabled = True
        txtFolder2.SetFocus
        Exit Sub
       ElseIf txtTestoEmail2.Text = "" Then
         MsgBox "Attenzione! Visualizza i dati prima della modifica!"
        txtTestoEmail2.Enabled = True
       txtTestoEmail2.SetFocus
         Exit Sub
    ElseIf IsNumeric(txtTestoEmail2.Text) Then
        MsgBox "Attenzione! Specifica un TestoEmail"
        txtTestoEmail2.Enabled = True
        txtTestoEmail2.SetFocus
       Exit Sub
        Exit Sub
    End If
   
    blnAggiorna = False
    x = 1
   
    Do Until blnAggiorna = True Or x = Range("A1").CurrentRegion.Rows.Count
   
        If Range("A" & x) = txtCodiceRegola2.Text Then
         intRisposta = MsgBox("Sei sicuro di voler aggiornare la regola e-mail con CodiceRegola " & txtCodiceRegola2.Text & "?", vbYesNo, "Attenzione!")
            If intRisposta = vbYes Then
            'scrivo nel foglio excel
                Range("B" & x) = txtFolder2.Text
                Range("C" & x) = txtTestoEmail2.Text
               
            'correggo i dati anche nell'altra pagina
                txtFolder.Text = txtFolder2.Text
                txtTestoEmail.Text = txtTestoEmail2.Text
                MsgBox "La regola e-mail " & txtCodiceRegola2.Text & " è stata aggiornata"
               
            End If
            blnAggiorna = True
        End If
        x = x + 1
    Loop
End Sub




Private Sub cmdAggiungiRegola_Click()
Dim h As Integer
Dim blnAggiungi As Boolean

' controllo che non siano dati vuoti
    If txtCodiceRegola3.Text = "" Then
        MsgBox "Attenzione! Non hai impostato un valore nella casella Regola e-mail!"
        txtCodiceRegola3.SetFocus
        Exit Sub
    ElseIf txtFolder3.Text = "" Then
        MsgBox "Attenzione! Non hai impostato un valore nella casella Folder!"
        txtFolder3.SetFocus
        Exit Sub
   
    ElseIf txtTestoEmail3.Text = "" Then
        MsgBox "Attenzione! Non hai impostato un valore nella casella Testo e-mail!"
        txtTestoEmail3.SetFocus
        Exit Sub
   End If
   

    blnAggiungi = False
    h = 1
    Do Until blnAggiungi = True Or h = Range("A1").CurrentRegion.Rows.Count

        If Range("A" & h) = txtCodiceRegola3.Text Then
            MsgBox ("Attenzione! esiste già un codice con questa Regola e-mail")
            txtCodiceRegola3.SetFocus
            blnAggiungi = True
            Exit Sub
        ElseIf Range("A" & h) = "" Then
            blnAggiungi = True
        End If
        h = h + 1
    Loop

    Range("A" & h + 1) = txtCodiceRegola3.Text   
    Range("C" & h + 1) = txtTestoEmail3.Text
 
   
    MsgBox "La regola e-mail " & txtCodiceRegola3.Text & " è stato inserita"

End Sub



Private Sub cmdCancellaRegola_Click()
    blnCancella = False
    I = 1
    Do Until blnCancella = True Or I = Range("A1").CurrentRegion.Rows.Count
        If Range("A" & I) = txtCodiceRegola.Text Then
            intRisposta = MsgBox("Sei sicuro di voler cancellare l'articolo con CodiceRegola " & txtCodiceRegola.Text & "?", vbYesNo + vbCritical, "Attenzione!")
            If intRisposta = vbYes Then
                Range("a" & I).Select
                Selection.EntireRow.Delete
           
                MsgBox "L'articolo con CodiceRegola " & txtCodiceRegola.Text & " è stato cancellato"
                txtCodiceRegola.Text = ""
                txtFolder.Text = ""
               
                txtTestoEmail.Text = ""
               
                txtCodiceRegola.SetFocus
            End If
            blnCancella = True
        End If
        I = I + 1
    Loop

    If blnCancella = False Then
   NonTrovato (txtCodiceRegola.Text)
    End If
End Sub



Private Sub cmdChiudi_Click()
Unload frmGestioneTestoEmail
End Sub

Private Sub cmdChiudi2_Click()
cmdChiudi_Click
End Sub

Private Sub cmdChiudi3_Click()
cmdChiudi_Click
End Sub



Private Sub cmdMostraRegola_Click()

    blnTrovato = False
    y = 1
   
    Do Until blnTrovato = True Or y = Range("A1").CurrentRegion.Rows.Count
        If Range("A" & y) = txtCodiceRegola.Text Then
            txtFolder.Text = Range("B" & y)
           
            txtTestoEmail.Text = Range("C" & y)
           
            blnTrovato = True
        End If
        y = y + 1
    Loop

    If blnTrovato = False Then
  NonTrovato (txtCodiceRegola.Text)
    End If

End Sub




Private Sub txtCodiceRegola_Change()
'le due pagine mostrano gli stessi dati
txtCodiceRegola2.Text = txtCodiceRegola.Text
End Sub

Private Sub txtFolder_Change()
'le due pagine mostrano gli stessi dati
txtFolder2.Text = txtFolder.Text
End Sub

Private Sub txtTestoEmail_Change()
'le due pagine mostrano gli stessi dati
txtTestoEmail2.Text = txtTestoEmail.Text
End Sub

Private Sub NonTrovato(CodiceRegola As String)
    MsgBox "La regola e-mail " & CodiceRegola & " non è in elenco"
    txtCodiceRegola.Text = ""
    txtCodiceRegola.SetFocus
End Sub

'Grazie di tutto Anthony, ho imparato tantissimo
'End sub ;o)

[Anthony47]

'Grazie di tutto Anthony, ho imparato tantissimo
'End sub ;o)

Bravo...
Adesso devi solo imparare a inserire il "tag" Code attorno al codice e sara' perfetto

Alla prossima!

[fulviot]

Ciao, scusate se non ho più risposto a questo post, ma non mi arrivano le mail di aggiornamento del topic, comunque, non sarei stato molto di aiuto ed ho visto che Anthony ha risposto a tutte le domande.

Per quanto mi riguarda non ricordo il motivo esatto per cui ho cercato di fare questo programmino da excel, probabilmente è perché mi trovo bene con excell e sto cercando di inventarmi sempre nuovi scenari di studio, ma concordo che sarebbe stato meglio farlo direttamente da Outlook.