Boucle et Outlook

Le
Alex
Bonjour à tous,

J'ai un problème sur une boucle pour communiquer avec outlook depuis
Excel, avec une condition.
Mon tableau est simple, Titres Colonnes :
A = Nom
B= Prénom
C= Adresse Mail
D à F = autres information concernant le Nom
G à W = des References articles
X = Total Articles
Y= Commande modifiee pour raison bugétaire

Sur Chaque ligne, les infos correspondent aux titres des colonnes, et
pour les colonnes de G à W = nombre d'article de la référence artic=
le
et colonne Y = M si modifié, et vide si pas modifié.

Ma condition : si valeur "M" en colonne Y, alors envoi d'un mail avec
message informant l'interessé qu'il y a eu modification de sa demande,
si vide, confirmation de la commande. (Juste le corps du texte d'intro
qui change)

La boucle, pour qu'il me fasse un mail pour chacune des lignes et en
fonction de la colonne Y, et j'ai écrit ceci :

Sub ConfirmationCommande()

Sheets("RECAP").Select
'Création doublon feuille
Sheets("RECAP").Copy Before:=Sheets(1)
Sheets("RECAP (2)").Activate
'Suppression Filtre
Range("A1:X1").Select
Application.CutCopyMode = False
Selection.AutoFilter
'Remise en forme Texte et Titre
Range("G1:X1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("G1").Select
ActiveCell.FormulaR1C1 = "Socle en bois - ""BLOC PRATIC"" sans
recharge"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Agenda 22X14 - 1 jour à la page
couverture cartonnée"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Recharge ""BLOC PRATIC"" - Date à
gauche"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Agenda 35X15 - 1 jour à la page
couverture cartonnée"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Calendrier bloc éphéméride 8X10 sur
plaque"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Planning vacances et absences Décembre =
à
Décembre"
Range("M1").Select
ActiveCell.FormulaR1C1 = "Calendrier cartonné 21X29,7 6 mois sur
chaque face"
Range("N1").Select
ActiveCell.FormulaR1C1 = "Calendrier cartonné 13X17 6 mois sur
chaque face"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Guilplan 16X16 AGENDA DE BUREAU"
Range("P1").Select
ActiveCell.FormulaR1C1 = "811859" & Chr(10) & "Guilplan 16X24
AGENDA DE BUREAU" & Chr(10) & "1.04"
Range("P1").Select
ActiveCell.FormulaR1C1 = "Guilplan 16X24 AGENDA DE BUREAU"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "Guilplan 21X27 AGENDA DE BUREAU"
Range("R1").Select
ActiveCell.FormulaR1C1 = "Guilplan 24X24 AGENDA DE BUREAU"
Range("W1").Select
'Comptage des lignes et envoi mail
Dim Nbligne As Long
Dim Outl As New Outlook.Application
Dim Olmail As MailItem
Dim i
i = ActiveCell.Row
Nbligne = Range("A2").CurrentRegion.Rows.Count
'Version texte si M en colonne Y
For i = Nbligne To 2 Step 1
If Cells("Y", i).Value = "M" Then
Set Outl = New Outlook.Application
Set Olmail = Outl.CreateItem(olMailItem)
With Olmail
.To = Range("C", i).Value
.Subject = "Votre Commande d'Agenda modifiée"
.Body = "Bonjour," & Chr(13) _
& Chr(13) _
& "Veuillez trouver ci-dessous, votre Commande d'Agenda et de
Calendrier qui a été modifiée pour des raisons budgétaire, comme
suit :" & Chr(13) _
& Chr(13) _
& Range("G1").Value & " : " & Cells(i, "G").Value & Chr(13) _
& Range("H1").Value & " : " & Cells(i, "H").Value & Chr(13) _
& Range("I1").Value & " : " & Cells(i, "I").Value & Chr(13) _
& Range("J1").Value & " : " & Cells(i, "J").Value & Chr(13) _
& Range("K1").Value & " : " & Cells(i, "K").Value & Chr(13) _
& Range("L1").Value & " : " & Cells(i, "L").Value & Chr(13) _
& Range("M1").Value & " : " & Cells(i, "M").Value & Chr(13) _
& Range("N1").Value & " : " & Cells(i, "N").Value & Chr(13) _
& Range("O1").Value & " : " & Cells(i, "O").Value & Chr(13) _
& Range("P1").Value & " : " & Cells(i, "P").Value & Chr(13) _
& Range("Q1").Value & " : " & Cells(i, "Q").Value & Chr(13) _
& Range("R1").Value & " : " & Cells(i, "R").Value & Chr(13) _
& Range("S1").Value & " : " & Cells(i, "S").Value & Chr(13) _
& Range("T1").Value & " : " & Cells(i, "T").Value & Chr(13) _
& Range("U1").Value & " : " & Cells(i, "U").Value & Chr(13) _
& Range("V1").Value & " : " & Cells(i, "V").Value & Chr(13) _
& Range("W1").Value & " : " & Cells(i, "W").Value & Chr(13) _
& "=
==
" &
Chr(13) _
& "TOTAL ARTICLE(S)" & " : " & Cells(i, "X").Value & Chr(13) _
& Chr(13) _
& "Cordialement," & Chr(13) & "Service Organisation Gestion"
.Send
End With
'Version si pas de M en colonne Y
Else:
Set Outl = New Outlook.Application
Set Olmail = Ol.CreateItem(olMailItem)
With Olmail
.To = Range("i,C").Value
.Subject = "Confirmation de votre Commande d'Agenda"
.Body = "Bonjour," & Chr(13) _
& Chr(13) _
& "Veuillez trouver ci-dessous, votre confirmation de Commande
d'Agenda et de Calendrier pour l'année prochaine :" & Chr(13) _
& Chr(13) _
& Range("G1").Value & " : " & Cells(i, "G").Value & Chr(13) _
& Range("H1").Value & " : " & Cells(i, "H").Value & Chr(13) _
& Range("I1").Value & " : " & Cells(i, "I").Value & Chr(13) _
& Range("J1").Value & " : " & Cells(i, "J").Value & Chr(13) _
& Range("K1").Value & " : " & Cells(i, "K").Value & Chr(13) _
& Range("L1").Value & " : " & Cells(i, "L").Value & Chr(13) _
& Range("M1").Value & " : " & Cells(i, "M").Value & Chr(13) _
& Range("N1").Value & " : " & Cells(i, "N").Value & Chr(13) _
& Range("O1").Value & " : " & Cells(i, "O").Value & Chr(13) _
& Range("P1").Value & " : " & Cells(i, "P").Value & Chr(13) _
& Range("Q1").Value & " : " & Cells(i, "Q").Value & Chr(13) _
& Range("R1").Value & " : " & Cells(i, "R").Value & Chr(13) _
& Range("S1").Value & " : " & Cells(i, "S").Value & Chr(13) _
& Range("T1").Value & " : " & Cells(i, "T").Value & Chr(13) _
& Range("U1").Value & " : " & Cells(i, "U").Value & Chr(13) _
& Range("V1").Value & " : " & Cells(i, "V").Value & Chr(13) _
& Range("W1").Value & " : " & Cells(i, "W").Value & Chr(13) _
& "=
==
" &
Chr(13) _
& "TOTAL ARTICLE(S)" & " : " & Cells(i, "X").Value & Chr(13) _
& Chr(13) _
& "Cordialement," & Chr(13) & "Service Organisation Gestion"
.Send
End With
End If
Next i
End Sub

Mais voilà, aucune boucle ne se fait et aucun mail part. J'ai tenté
sans condition, mais pas mieux - pas de boucle.

Merci par avance de votre aide.
Cordialement.
Alex
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Alex
Le #19666371
On 28 juin, 11:56, Alex
Bonjour à tous,

J'ai un problème sur unebouclepour communiquer avecoutlookdepuis
Excel, avec une condition.
Mon tableau est simple, Titres Colonnes :
     A = Nom
     B= Prénom
     C= Adresse Mail
     D à F = autres information concernant le Nom
     G à W = des References articles
     X = Total Articles
     Y= Commande modifiee pour raison bugétaire

Sur Chaque ligne, les infos correspondent aux titres des colonnes, et
pour les colonnes de G à W = nombre d'article de la référence art icle
et colonne Y = M si modifié, et vide si pas modifié.

Ma condition : si valeur "M" en colonne Y, alors envoi d'un mail avec
message informant l'interessé qu'il y a eu modification de sa demande,
si vide, confirmation de la commande. (Juste le corps du texte d'intro
qui change)

Laboucle, pour qu'il me fasse un mail pour chacune des lignes et en
fonction de la colonne Y, et j'ai écrit ceci :

Sub ConfirmationCommande()

Sheets("RECAP").Select
'Création doublon feuille
Sheets("RECAP").Copy Before:=Sheets(1)
Sheets("RECAP (2)").Activate
'Suppression Filtre
Range("A1:X1").Select
Application.CutCopyMode = False
Selection.AutoFilter
'Remise en forme Texte et Titre
Range("G1:X1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Socle en bois - ""BLOC PRATIC"" sans
recharge"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Agenda 22X14 - 1 jour à la page
couverture cartonnée"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Recharge ""BLOC PRATIC"" - Date à
gauche"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Agenda 35X15 - 1 jour à la page
couverture cartonnée"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "Calendrier bloc éphéméride 8X10 sur
plaque"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Planning vacances et absences Décem bre à
Décembre"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Calendrier cartonné 21X29,7 6 mois sur
chaque face"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Calendrier cartonné 13X17 6 mois su r
chaque face"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "Guilplan 16X16 AGENDA DE BUREAU"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "811859" & Chr(10) & "Guilplan 16X24
AGENDA DE BUREAU" & Chr(10) & "1.04"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Guilplan 16X24 AGENDA DE BUREAU"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "Guilplan 21X27 AGENDA DE BUREAU"
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "Guilplan 24X24 AGENDA DE BUREAU"
    Range("W1").Select
'Comptage des lignes et envoi mail
Dim Nbligne As Long
Dim Outl As NewOutlook.Application
Dim Olmail As MailItem
Dim i
i = ActiveCell.Row
Nbligne = Range("A2").CurrentRegion.Rows.Count
'Version texte si M en colonne Y
For i = Nbligne To 2 Step 1
    If Cells("Y", i).Value = "M" Then
    Set Outl = NewOutlook.Application
    Set Olmail = Outl.CreateItem(olMailItem)
        With Olmail
        .To = Range("C", i).Value
        .Subject = "Votre Commande d'Agenda modifiée"
        .Body = "Bonjour," & Chr(13) _
        & Chr(13) _
        & "Veuillez trouver ci-dessous, votre Commande d'Agenda e t de
Calendrier qui a été modifiée pour des raisons budgétaire, comme
suit :" & Chr(13) _
        & Chr(13) _
        & Range("G1").Value & " : " & Cells(i, "G").Value & Chr(1 3) _
        & Range("H1").Value & " : " & Cells(i, "H").Value & Chr(1 3) _
        & Range("I1").Value & " : " & Cells(i, "I").Value & Chr(1 3) _
        & Range("J1").Value & " : " & Cells(i, "J").Value & Chr(1 3) _
        & Range("K1").Value & " : " & Cells(i, "K").Value & Chr(1 3) _
        & Range("L1").Value & " : " & Cells(i, "L").Value & Chr(1 3) _
        & Range("M1").Value & " : " & Cells(i, "M").Value & Chr(1 3) _
        & Range("N1").Value & " : " & Cells(i, "N").Value & Chr(1 3) _
        & Range("O1").Value & " : " & Cells(i, "O").Value & Chr(1 3) _
        & Range("P1").Value & " : " & Cells(i, "P").Value & Chr(1 3) _
        & Range("Q1").Value & " : " & Cells(i, "Q").Value & Chr(1 3) _
        & Range("R1").Value & " : " & Cells(i, "R").Value & Chr(1 3) _
        & Range("S1").Value & " : " & Cells(i, "S").Value & Chr(1 3) _
        & Range("T1").Value & " : " & Cells(i, "T").Value & Chr(1 3) _
        & Range("U1").Value & " : " & Cells(i, "U").Value & Chr(1 3) _
        & Range("V1").Value & " : " & Cells(i, "V").Value & Chr(1 3) _
        & Range("W1").Value & " : " & Cells(i, "W").Value & Chr(1 3) _
        & "================== ========================= ============" &
Chr(13) _
        & "TOTAL ARTICLE(S)" & " : " & Cells(i, "X").Value & Chr( 13) _
        & Chr(13) _
        & "Cordialement," & Chr(13) & "Service Organisation Gesti on"
        .Send
        End With
'Version si pas de M en colonne Y
    Else:
    Set Outl = NewOutlook.Application
    Set Olmail = Ol.CreateItem(olMailItem)
        With Olmail
        .To = Range("i,C").Value
        .Subject = "Confirmation de votre Commande d'Agenda"
        .Body = "Bonjour," & Chr(13) _
        & Chr(13) _
        & "Veuillez trouver ci-dessous, votre confirmation de Com mande
d'Agenda et de Calendrier pour l'année prochaine :" & Chr(13) _
        & Chr(13) _
        & Range("G1").Value & " : " & Cells(i, "G").Value & Chr(1 3) _
        & Range("H1").Value & " : " & Cells(i, "H").Value & Chr(1 3) _
        & Range("I1").Value & " : " & Cells(i, "I").Value & Chr(1 3) _
        & Range("J1").Value & " : " & Cells(i, "J").Value & Chr(1 3) _
        & Range("K1").Value & " : " & Cells(i, "K").Value & Chr(1 3) _
        & Range("L1").Value & " : " & Cells(i, "L").Value & Chr(1 3) _
        & Range("M1").Value & " : " & Cells(i, "M").Value & Chr(1 3) _
        & Range("N1").Value & " : " & Cells(i, "N").Value & Chr(1 3) _
        & Range("O1").Value & " : " & Cells(i, "O").Value & Chr(1 3) _
        & Range("P1").Value & " : " & Cells(i, "P").Value & Chr(1 3) _
        & Range("Q1").Value & " : " & Cells(i, "Q").Value & Chr(1 3) _
        & Range("R1").Value & " : " & Cells(i, "R").Value & Chr(1 3) _
        & Range("S1").Value & " : " & Cells(i, "S").Value & Chr(1 3) _
        & Range("T1").Value & " : " & Cells(i, "T").Value & Chr(1 3) _
        & Range("U1").Value & " : " & Cells(i, "U").Value & Chr(1 3) _
        & Range("V1").Value & " : " & Cells(i, "V").Value & Chr(1 3) _
        & Range("W1").Value & " : " & Cells(i, "W").Value & Chr(1 3) _
        & "================== ========================= ============" &
Chr(13) _
        & "TOTAL ARTICLE(S)" & " : " & Cells(i, "X").Value & Chr( 13) _
        & Chr(13) _
        & "Cordialement," & Chr(13) & "Service Organisation Gesti on"
        .Send
    End With
    End If
    Next i
 End Sub

Mais voilà, aucunebouclene se fait et aucun mail part. J'ai tenté
sans condition, mais pas mieux - pas deboucle.

Merci par avance de votre aide.
Cordialement.
Alex





Re Bonjour à tous, (Astuce et solution... lol)
J'ai recherché et testé les différents conseils et solutions de mêm e
type, mais rien n'a faire ...ça passait toujours pas!!!. Alors j'ai
testé ma macro, mais cette fois ci, en idenquant que les cellules de
la ligne 2, 1ère ligne de reference des mails à envoyer. Et cela a
fonctionné tout de suite. J'ai alors procédé à un DO WHILE avec un
controle de la valeur de la cellule C2 (adresse mai)l <> "" et
ajouter après le .send une commande de suppression de la ligne 2....
Il faut bien entendu faire une copie de la feuille, sinon vous perdrez
toutes les données... C bête lol (<= Ca c'était le côté Astuce )

Maintenant la solution : (Ca parrait long, mais c'est surtout du
texte)

Sub ENVOI_MAIL_MULTIPLE()

Dim Ol As New Outlook.Application
Dim Message As MailItem
Dim Text As Object

Sheets("RECAP").Select
'Création doublon feuille
Sheets("RECAP").Copy Before:=Sheets(1)
Sheets("RECAP (2)").Activate
'Suppression Filtre
Range("A1:X1").Select
Application.CutCopyMode = False
Selection.AutoFilter
'ENVOI MAIL DANS DO WHILE LOOP
Sheets("RECAP (2)").Select
Do While Range("C2").Value <> ""
Set Ol = New Outlook.Application
Set Message = Ol.CreateItem(olMailItem)
With Message
.To = Range("C2").Value
.Subject = Range("Z2").Value
.Body = "Bonjour," & Chr(13) _
& Chr(13) & Range("Y2") & Chr(13) & Chr(13) _
& "Socle en bois - ""BLOC PRATIC"" sans recharge : " &
Range("G2").Value & Chr(13) _
& "Recharge ""BLOC PRATIC"" - Date à gauche : " & Range
("H2").Value & Chr(13) _
& "Agenda 22X14 - 1 jour à la page couverture cartonnée :
" & Range("I2") & Chr(13) _
& "Agenda 35X15 - 1 jour à la page couverture cartonnée :
" & Range("J2").Value & Chr(13) _
& "Calendrier bloc éphéméride 8X10 sur plaque : " & Range
("K2").Value & Chr(13) _
& "Planning vacances et absences Décembre à Décembre" &
Range("L2").Value & Chr(13) _
& "Calendrier cartonné 21X29,7 6 mois sur chaque face" &
Range("M2").Value & Chr(13) _
& "Calendrier cartonné 13X17 6 mois sur chaque face : " &
Range("N2").Value & Chr(13) _
& "Guilplan - 16X16 - AGENDA DE BUREAU : " & Range
("O2").Value & Chr(13) _
& "Guilplan - 16X24 - AGENDA DE BUREAU : " & Range
("P2").Value & Chr(13) _
& "Guilplan - 21X27 - AGENDA DE BUREAU : " & Range
("Q2").Value & Chr(13) _
& "Guilplan - 24X24 - AGENDA DE BUREAU : " & Range
("R2").Value & Chr(13) _
& "Semaine Poche Temporel 16 - 16X8 : " & Range
("S2").Value & Chr(13) _
& "Recharge EXATIME 14 - 2J/P - 12X8 : " & Range
("T2").Value & Chr(13) _
& "Recharge EXATIME 17 - 1S/2P - 17X10 ; " & Range
("U2").Value & Chr(13) _
& "Recharge Semainier - OBER ""UP TO DAT"" - 48660 : " &
Range("V2").Value & Chr(13) _
& "CALENDRIER SEMESTRIEL GMF - 36X43 : " & Range
("W2").Value & Chr(13) _
&
"======================== ========================= ======================"
& Chr(13) _
& "TOTAL ARTICLE(S) : " & Range("X2").Value & Chr(13) _
& Chr(13) _
& "Cordialement," & Chr(13) & "Service Organisation
Gestion"
.Send
End With
Rows("2:2").Select
Selection.Delete Shift:=xlUp
Range("C2").Select

Loop

Sheets("RECAP (2)").Select
ActiveWindow.SelectedSheets.Delete
End Sub



Voilà, j'espère que ca pourra être utile à quelqu'un, c'est ma fa çon
de remercié toutes les personnes qui ont pu m'aider, ou m'aiguiller
devant d'autres problèmes VBA.
Cordialement.
Alex
Publicité
Poster une réponse
Anonyme