Envoie Mail automatique Outlook via Excel VBA [Résolu]

Réponse 2 / 17

simon7339 Messages postés 68 Date d'inscription Statut Membre Dernière intervention 1

Bonjour à tous,

Peut être que ce que je cherche à faire est impossible non?

Merci d'avance pour votre réponse.

Réponse 3 / 17

Bonjour,

Tout d'abord ce n'est pas la cellule k, c'est la colonne K. Pour la cellule c'est K1 par exemple.

Voici un code a toi de l'adapter:

Private Sub CommandButton1_Click()
If Range("K1").Value = "" Then
envoimail
Range("K1").Value = "RELANCE 1"
Else
MsgBox "Relance déjà effectuée!"
End If
End Sub
Sub envoimail()
    Set OlApp = CreateObject("Outlook.application")
    Set OlItem = OlApp.CreateItem(olMailItem)
    With OlItem
        .To = "adresse@mail" 'Range("G1").Value
        .Subject = "This will work!" 'Range("C1").Value
        .Body = "This works great, no warning message from Outlook!"
        .Display 'Ou .Send
    End With
End Sub

Réponse 4 / 17

simon7339 Messages postés 68 Date d'inscription Statut Membre Dernière intervention 1

Ok super tu m'as bien débloqué. Maintenant je bloque sur les boucles.
Du coup imaginons que je commence en ligne 2. Donc je pose i = 2.

Le problème c'est que quand j'arrive à la fin i = 3 mais quand je reviens à la 1ère procédure ça remet i = 2 (vu que je l'ai défini comme telle). Je sais pas comment faire pour enchainer les deux procédures en mode boucle.

J'espère que tu vois ce que je veux dire.

Merci d'avance pour ton aide

Private Sub Testmailauto()
Dim i As Integer
i = 2
While i < 100

If Range("K" & i).Value = "" Then
Range("K" & i).Select
ActiveCell.FormulaR1C1 = "RELANCE 1"
envoimail1

Else
MsgBox "Relance déjà effectuée!"
End If
Wend
End Sub

Sub envoimail1()
Dim i As Integer
i = 2
While i < 100

    Set OlApp = CreateObject("Outlook.application")
    Set OlItem = OlApp.CreateItem(olMailItem)
    
    Carrier = Range("G" & i).Value
    Columns("N:N").Select
    Selection.Find(What:=Carrier, After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext).Activate
        
Adresse = ActiveCell.Offset(0, 1).Value
    
    With OlItem
        .To = Adresse
        .Subject = "Demande de LTA pour le BL " & Range("C" & i).Value
        .Body = "Bonjour, Merci de me communiquer la LTA pour le transport " & Range("D" & i).Value
        .Display 'Ou .Send
    End With
    i = i + 1
    Testmailauto
    Wend
End Sub

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 17

Tu ne trouves pas qu'il y a quelque chose qui cloche:

dans Private Sub Testmailauto()

tu mets : envoimail1

et dans Sub envoimail1()

tu mets : Testmailauto

réfléchis bien à ce que tu veux faire!

normalement dans la sub envoimail1 il n'y a pas a avoir de boucle et de:

Testmailauto

Réponse 6 / 17

simon7339 Messages postés 68 Date d'inscription Statut Membre Dernière intervention 1

D'accord mais il faut bien qu'à la fin de la procédure envoimail1 je lui dise de retourner à la TestMailauto pour qu'elle passe à la cellule K3 non?

Réponse 7 / 17

Et comme ceci:

Private Sub Testmailauto()
Dim i As Integer
i = 2
While i < 100

If Range("K" & i).Value = "" Then
Range("K" & i).Select
ActiveCell.FormulaR1C1 = "RELANCE 1"
envoimail1
i= i+1
Else
MsgBox "Relance déjà effectuée!"
End If
Wend
End Sub

en enlevant la boucle et Testmailauto dans envoimail1

Réponse 8 / 17

simon7339 Messages postés 68 Date d'inscription Statut Membre Dernière intervention 1

Private Sub Testmailauto()
Dim i As Integer
i = 2
While i < 100

If Range("K" & i).Value = "" Then

Range("K" & i).Select

ActiveCell.FormulaR1C1 = "RELANCE 1"

envoimail1

i = i + 1

Else
MsgBox "Relance déjà effectuée!"

End If

Wend


End Sub

Sub envoimail1()
Dim i As Integer
Dim Ligne As Long

Ligne = ActiveCell.Row
i = Ligne



    Set OlApp = CreateObject("Outlook.application")
    Set OlItem = OlApp.CreateItem(olMailItem)
    
    Carrier = Range("G" & i).Value
    Columns("N:N").Select
    Selection.Find(What:=Carrier, After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext).Activate
        
Adresse = ActiveCell.Offset(0, 1).Value
    
    With OlItem
        .To = Adresse
        .Subject = "Demande de LTA pour le BL " & Range("C" & i).Value
        .Body = "Bonjour, Merci de me communiquer la LTA pour le transport " & Range("D" & i).Value
        .Display 'Ou .Send
    End With
    
  
End Sub

Voilà où j'en suis maintenant. J'ai mis i = ligne active dans la 2ème procédure ça marche bien. Merci pour ton aide, je suis désolé je débute sur VBA et je t'avoue que les boucles me perdent un peu mais là j'ai mieux compris comment ça fonctionnait.

Le problème c'est que la macro tourne en rond parce quand elle arrive à une cellule K qui n'est pas vide (soit parce que déjà relancé ou parce que rempli) elle ne va pas rechercher à i +1 et reste sur la cellule remplie.

Du coup si je mets i = i+1 après le MsgBox c'est bon mais par contre faut que je lui dise de tout arrêter quand par exemple ActiveCellOffset (0,-1)IsEmpty.

Désolé je galère

Réponse 9 / 17

simon7339 Messages postés 68 Date d'inscription Statut Membre Dernière intervention 1

Et encore je dis des bêtises c'est pas grave au pire je ferais un filtre sur les cellules vides pour pas qu'elle rencontre de problèmes. En faite je voudrais juste faire qu'elle s'arrête quand elle rencontre une ligne vide

Réponse 10 / 17

voir ce site pour les boucles:

https://silkyroad.developpez.com/vba/boucles/#LV

Sub Test_WhileWend()
    Dim i As Integer
    
    i = 1
    
    'Boucle sur les cellules de la colonne A
    'On sort de la boucle si la cellule testée (Cells(i, 1)) est vide
    While Not IsEmpty(Cells(i, 1))
        'Ecrit le contenu de la cellule dans la fenêtre d'exécution.
        Debug.Print Cells(i, 1)
        'Incrémente la variable d'une unité afin de tester la cellule suivante.
        i = i + 1
    Wend
End Sub

Réponse 11 / 17

Je pense que pour ton cas une boucle Do loop serait plus adaptée:

Sub Boucle_V03()
    Dim Trouve As Boolean
    Dim x As Integer
    
    Trouve = False
    x = 2
    Do
        'Boucle tant que le compteur x est inférieur à 100
        Do While x < 100
            'Incrémente le compteur.
            x = x + 1
            'Vérifie le contenu de la cellule.
            If Cells(x, 1) = "" Then
                'Attribue la valeur Vrai si la cellule est trouvée.
                Trouve = True
                'Anticipe la sortie de la boucle.
                Exit Do
            End If
        Loop
    'Quitte la boucle si la variable à la valeur True.
    Loop Until Trouve = True Or x = 100

    'Affiche un message en fonction du résultat de la recherche.
    MsgBox IIf(Trouve = True, "Trouvé ligne " & x, "Pas trouvé")

'  là tu mets ton action
    envoimail1

End Sub

Réponse 12 / 17

simon7339 Messages postés 68 Date d'inscription Statut Membre Dernière intervention 1

Merci, je viens de voir tes réponses, j'essaie de digérer tout ça. Encore merci c'est vraiment super d'avoir des gens comme toi qui aide

Réponse 13 / 17

simon7339 Messages postés 68 Date d'inscription Statut Membre Dernière intervention 1

Ca marche plutôt pas mal sauf pour faire arrêter la macro.

Avec ton exemple j'arrive à la stopper si je met par exemple
Loop Until Trouve = True Or x = 5

Mais j'aimerais qu'elle s'arrête seul quand elle rencontre une celulle vide en (x,7).

J'ai donc essayé Loop Until Trouve = True And IsEmptyCells(x,7) mais ça ne marche pas.

Désolé je me sens nul

Réponse 14 / 17

simon7339 Messages postés 68 Date d'inscription Statut Membre Dernière intervention 1

C'est bon excuse moi pour le dérangement enfaite il fallait que je mette

If Trouve = True And Cells(x, 7) <> "" Then

Réponse 15 / 17

simon7339 Messages postés 68 Date d'inscription Statut Membre Dernière intervention 1

Donc voilà pour ceux que ça intéresse voilà le code final qui marche parfaitement.
Merci Le Pivert ;)

Sub Testmailauto1()
Dim Trouve As Boolean
Dim x As Integer

Trouve = False
x = 1

Do
    Do While x < 100
    x = x + 1
    
    If Cells(x, 11) = "" Then
    
    Trouve = True
        
    Exit Do
        
    End If
Loop


Loop Until Trouve = True

If Trouve = True And Cells(x, 7) <> "" Then
Range("K" & x).Select

ActiveCell.FormulaR1C1 = "RELANCE 1 du " & Date

envoimail1
Else
Exit Sub
End If
Testmailauto1
End Sub

Sub envoimail1()
Dim x As Integer
Dim Ligne As Long

Ligne = ActiveCell.Row
i = Ligne



    Set OlApp = CreateObject("Outlook.application")
    Set OlItem = OlApp.CreateItem(olMailItem)
    
    Carrier = Range("G" & i).Value
    Columns("N:N").Select
    Selection.Find(What:=Carrier, After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext).Activate
        
Adresse = ActiveCell.Offset(0, 1).Value
    
    With OlItem
        .To = Adresse
        .Subject = "Demande de LTA "
        .Body = "Bonjour, Merci de me communiquer la LTA pour le transport " & Range("D" & i).Value & " Numéro de BL " & Range("C" & i).Value
        .Display 'Ou .Send
    End With
    
  
End Sub

Réponse 16 / 17

Pourquoi as-tu mis?

Testmailauto1

a la fin de ta Sub Testmailauto1()

ATTENTION tu vas avoir une boucle sans fin

Réponse 17 / 17

simon7339 Messages postés 68 Date d'inscription Statut Membre Dernière intervention 1

Salut à toi,

Ba justement c'est en mettant Call Testmailauto1 que la macro tourne et me fait toutes les lignes.

Sans ça elle restait à End If et ne vérifiait pas toutes mes lignes.

Avec ce code la macro tourne parfaitement et ne fait pas de boucles sans fin.

Envoie Mail automatique Outlook via Excel VBA

17 réponses

Votre réponse

Discussions similaires