Autres "Incrémenter" les cellules dans une macro grace à une boucle ?

[Ezen]

Bonjour à tous, je suis tout à fait néophyte de VBA et j'ai quelques questions sur ce qui est faisable ou non.

J'ai une macro qui permet d'envoyer directement un mail via outlook a un destinataire dont le mail est dans une cellule précise, pareil pour la personne en CC. De la meme maniere le mail est accompagné d'une PJ dont le chemin d'accès se trouve dans une cellule. Voyez la macro (fonctionnelle en l'état mais peu utile) ci-dessous :


Sub mail_outlook()

Dim OutApp As Object
Dim OutMail As Object
Dim xMailBody As String
Dim ws As Worksheet
Set ws = Sheets("Clients - Fichier Clients")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


With OutMail
.To = ws.Range("C2").Value
.CC = ws.Range("D2").Value
.BCC = ""
.Subject = "Test de X"
.Body = "Ceci est un message test." & vbCrLf & "ceci est une nouvelle ligne"
.Attachments.Add ws.Range("X2").Value
On Error GoTo 0

.Display

End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Maintenant je voudrais changer cette macro de manière à ce qu'elle se repete tout en passant à la ligne du dessous à chaque fois. Concrètement : au lieu d'aller chercher
.To en C2 ; .CC en D2 et .Attachments.Add en X2 je voudrais qu'à la 1ere repetition la macro aille chercher .To en C3 ; .CC en D3 et .Attachments.Add en X3 puis à la repetition suivante .To en C4 ; .CC en D4 et .Attachments.Add en X4 et ainsi de suite jusqu'à trouver une ligne vide...

J'ai bien évidemment copié la plus grosse partie de cette macro sur le net et je ne sais pas comment m'y prendre pour la changer comme décrit plus haut....

Merci par avance à tous les pros d'excel/VBA qui m'aideront!

A+

Ezen

 

[Ezen]

Re


Non juste beaucoup d’étourderie de ma part, j’avais oublié le .

Sub mail_outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim xMailBody As String
Dim ws As Worksheet
Dim I As Integer
Dim DL As Integer

Set ws = Sheets("Feuil1")
DL = ws.Cells(Application.Rows.Count, "A").End(xlUp).Row
For I = 2 To DL
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .to = ws.Cells(I, "A").Value
        .cc = ""
        .BCC = ""
        .Subject = "Test de X"
        .Body = "Ceci est un message test." & vbCrLf & "ceci est une nouvelle ligne"
        'On Error Resume Next
        If ws.Cells(I, "H").Value <> "" Then .Attachments.Add ws.Cells(I, "H").Value
        .Display
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
Next I

End Sub

@Phil69970

Magnifique... Tout fonctionne impecablement!! Bravo et milles merci à toi, c'est fou ce qu'on peut faire avec VBA quand on s'y connait aussi bien.

J'essaye d'appliquer la macro à mon cas concret demain, mais visiblement ça ne devrait pas poser de problèmes. Je te souhaite une bonne soirée et d'excellentes fêtes de fin d'année.

Merci encore.

Ezen.