Vba-e Probleme boucle sur envoi mail

Bonjour,
J'ai un problème, j'ai une macro qui envoi un mail lorsque range("a1").value = "1"
Le problème c'est que cette valeur (1) ne doit pas changer, donc j'ai des envois de mail en boucle !

Comment faire en que la macro envoimail s'execute une seule fois après avoir tester la valeur de a1?
Merci !

23 réponses

  1. bonjour,

    une remarque ! range("a1").value = "1"
    le fait de mettre des guillemets te trompera si tu contrôles une valeur 1 est différent de "1"

    fait ce test
    Sub toto()
    Sheets("feuil1").Select
    If IsNumeric(Range("A1").Value) Then
    MsgBox ("c'est un chiffre")
    Else
    MsgBox ("c'est du texte")
    End If

    End Sub

    selon que cela te fait progresser ou non....
    tu peux nous montrer ta boucle....
    A+
    0
    1. Voila ma boucle :
      Private Sub Worksheet_Change(ByVal Target As Range)
      DateJour = Now
      DOA = Range("e161").Value
      Date48 = 48
      
      If DateJour - DOA > Date48 Then
          Range("z161").Value = "1"
              Else: Range("z161").Value = "0"
      End If
      Sheets("Main courante").Select
      If IsNumeric(Range("Z161").Value) Then
      Call SendMail_Outlook
      
      end sub

      Il me créé des centaines de messages outlook.
      0
      1. If DateJour - DOA > Date48 Then
        Range("z161").Value = 1
        Else: Range("z161").Value = 0
        End If

        Sheets("Main courante").Select
        If Range("Z161").Value<>0 Then
        Call SendMail_Outlook
        endif
        end sub
        0
        1. Toujours la boucle !
          J'ai remarqué que si je faisais, après SendMail_Outlook un Range("Z161").Value = 2
          Il restait à 1 mail.
          Donc il faut arrêter la macro SendMail_Outlook après une seule execution, comment faire?
          merci!
          0
          1. Range("Z161").Value = 2 ....... Il restait à 1 mail.
            C'est normal car tu utilises .... Worksheet_Change
            en mettant 2 il y a un changement donc tu relances la procédure et comme
            la valeur est différente de 0 tu lances un mail.
            mais on peut améliorer...

            Essaye ça!

            Private Sub Worksheet_Change(ByVal Target As Range)
            DateJour = Now
            DOA = Range("e161").Value
            Date48 = 48

            If DateJour - DOA > Date48 Then
            Range("z161").Value = 1
            Else: Range("z161").Value = 0
            End If

            Sheets("Main courante").Select
            If Range("Z161").Value<>0 and Range("Z161").Value<2 Then
            Call SendMail_Outlook
            endif
            end sub

            A+
            0
            1. Ton code marche !
              mais la je comprends pas ! qd j'entre une date dans e165, il m'envoi quand même un tas d'e-mail !
              je n'ai donné aucune instruction ni conidtion sur cette cellule !
              je pense que c'est Private Sub Worksheet_Change(ByVal Target As Range) qui gene.

              on v y arriver ! :p
              0
              1. Si on mettait un bouton : Tester la feuille, et les instructions et conditions sur un _Click ?
                Parce que a chaque fois qu'on modifit une cellule il reteste Z161 j'ai l'impression.
                0
                1. Non il faut faire un petit truc différend !

                  Patiente je te dis çA...
                  0
                  1. Essaye comme ça!
                    j'ai mis des commentaires ... il faut lire

                    Private Sub Worksheet_Change(ByVal Target As Range)
                    Dim Intersection As Range, Plage As Range

                    Set Plage = Range("Z161") ' on ne contrôle qu'une cellule
                    Set Intersection = Application.Intersect(Target, Plage)

                    DateJour = Now
                    DOA = Range("e161").Value
                    Date48 = 48

                    If DateJour - DOA > Date48 Then
                    Range("z161").Value = 1
                    Else: Range("z161").Value = 0
                    End If

                    Sheets("Main courante").Select
                    If Intersection Is Nothing Then
                    ' on ne fait rien c'est pas la bonne cellule
                    Else
                    'c'est Z161 on fait le traitement
                    If Range("Z161").Value<>0 and Range("Z161").Value<2 Then
                    Call SendMail_Outlook
                    End if
                    End If

                    Set Plage = Nothing ' on reset l'objet
                    Set Intersection = Nothing ' idem

                    end sub
                    0
                    1. Ah j'ai compris, par contre à mon aivs, il y a une fonction qui s'appel récurisivemen, message d'erreur : espace pile insufisant
                      0
                      1. l'erreur est sur Call SendMail_Outlook !merci !
                        0
                        1. l'erreur doit venir de là!

                          Call SendMail_Outlook

                          Call signifie appelle de procedure pour execution.
                          SendMail_outlook est ta procedure.

                          comme outlook est une application
                          tu dois la retrouver dans un module .

                          il y aura une ligne un peu comme ça set monapp=application.... outlook
                          A la fin de la procedure
                          vérifie qu'il y a bien set monapp = nothing.
                          Cette erreur est commise par 95% des gens qui gens qui font un boulot mais ne range pas le matériel.

                          Vérifie aussi qu'il y a bien libération de l'application avec monapp.quit
                          Bien sur tu as compris que monapp est une variable objet elle s'appelle peut-être autrement ^^..

                          A+
                          0
                          1. Module


                            Sub SendMail_Outlook()
                            
                            Dim ol As New Outlook.Application
                            Dim olmail As MailItem
                            Dim CurrFile As String
                            Set ol = New Outlook.Application
                            Set olmail = ol.CreateItem(olMailItem)
                            
                            With olmail
                            .To = ""
                            .Subject = "Test"
                            .Body = ""
                            .display
                            End With
                            End Sub


                            Instruction
                            'c'est Z161 on fait le traitement
                            If Range("Z161").Value <> 0 And Range("Z161").Value < 2 Then
                            Call SendMail_Outlook
                            End If
                            End If
                            
                            Set Plage = Nothing ' on reset l'objet
                            Set Intersection = Nothing ' idem
                            Set ol = Nothing
                            End Sub


                            Même message d'erreur ! Je crois que je vais tout recommencer, et faire quelque chose de plus simple nan?
                            0
                            1. Qu'est-ce que je disais....

                              Sub SendMail_Outlook()

                              Dim ol As New Outlook.Application
                              Dim olmail As MailItem
                              Dim CurrFile As String
                              Set ol = New Outlook.Application
                              Set olmail = ol.CreateItem(olMailItem)


                              With olmail
                              .To = ""
                              .Subject = "Test"
                              .Body = ""
                              .display
                              End With

                              ol.quit
                              Set olmail=nothing

                              End Sub
                              0
                              1. Même message d'erreur !!!c'est pas possible ?!
                                Espace pille insufisant !
                                0
                                1. Même message d'erreur !!!c'est pas possible ?!
                                  Espace pille insufisant !
                                  0
                                  1. Le problème est difficile car moi je n'ai d'erreur.
                                    Je ne vois pas.
                                    je le fais sous 2007. avec la bibliothèque microsoft outlook 12.0
                                    je ne vois pas.
                                    je ne peux pas t'aider plus.
                                    0
                                    1. bonjour,

                                      Comment faire un call d'une macro dont l'indicateur est : Worksheet_Change(ByVal Target As Range)
                                      Call Worksheet_Change ne fonctionne pas !

                                      merci!
                                      0
                                      1. bonjour recopie ta macro dans un module

                                        sub test()

                                        ' adapte le code de ta macro

                                        end sub

                                        tu pourras alors appler ta macro avec call.

                                        Attention aux objets et variables déjà existante...
                                        A+
                                        0
                                        1. Oui mais alors comment mettre dans une macro sans procédure, une procédure comme Worksheet_Change(ByVal Target As Range) . Parce que si je supprime Worksheet_Change, mes instructions ne réagiront plus si les valeurs de la feuille change ?
                                          0
                                          • 1
                                          • 2