Envoie Mail automatique Outlook via Excel VBA

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

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 

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

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

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

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

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