Envoie Mail automatique Outlook via Excel VBA Résolu

Question

Bonjour à tous,

Je souhaiterais automatiser mon fichier excel de relance avec une VBA lié à Outlook.

Pour être précis : 

J'ai un fichier excel avec plein de lignes et des informations de la Celulle A à la Cellule K.

Je souhaiterais donc que si la cellule K est vide alors j'envoie un mail de relance automatique avec :

-MonMessage.To = en fonction du nom dans la cellule G alors l'adresse sera liée à ce nom (recherche V?)
-MonMessageSubject = devra être un texte fixe avec en variable la valeur contenu dans la cellule C
-MonMessageBody = qui sera fixe, càd toujours le même

Et une dernière chose qui serait idéal pour ne pas relancer à chaque fois les mêmes, serait qu'une fois le mail envoyé, le texte "RELANCE 1" s'inscrive dans la celulle K.

J'avais trouvé 2 modèles en fouillant sur Internet mais rien que je n'arrive à adapter seul.
Un avec ActiveCell.MailEnvelope et un autre avec :
Set MonOutlook = CreateObject("Outlook.Application")
  Set MonMessage = MonOutlook.createitem(0)

Merci d'avance pour votre aide.


Configuration: Windows 7 / Chrome 39.0.2171.95

simon7339 · Answer

Bonjour à tous,

Peut être que ce que je cherche à faire est impossible non?

Merci d'avance pour votre réponse.

cs_Le Pivert · Answer

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

simon7339 · Answer

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

cs_Le Pivert · Answer

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

simon7339 · Answer

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?

cs_Le Pivert · Answer

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

simon7339 · Answer

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

simon7339 · Answer

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

cs_Le Pivert · Answer

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

cs_Le Pivert · Answer

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

cs_Le Pivert · Answer

Rectification apportées pour ton projet:


Sub Testmailauto()
    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, 11) = "" 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.
   If Trouve = True Then
    Range("K" & x).Value = "RELANCE 1"
    envoimail1
    Else
   MsgBox "Relance déjà effectuée!"
   End If
End Sub

simon7339 · Answer

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

simon7339 · Answer

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

simon7339 · Answer

C'est bon excuse moi pour le dérangement enfaite il fallait que je mette

If Trouve = True And Cells(x, 7) <> "" Then

simon7339 · Answer

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

cs_Le Pivert · Answer

Pourquoi as-tu mis?

Testmailauto1

a la fin de ta Sub Testmailauto1()

ATTENTION tu vas avoir une boucle sans fin

simon7339 · Answer

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

Newsletters