Olmail à différentes personnes en meme temps

Bonjour à tous,

j'ai la macro suivante me permettant de générer un envoi de mail avec pièce jointe

Celle-ci va récupérer des données dans plusieurs onglets et me génère un array que je splitte.

tout fonctionne bien jusqu'ici c'est à dire que je récupéré les bonnes informations et les bons fichier à inclure

Result = Split(Mailing(i), "/")
'MsgBox ("Prenom: " & Result(0) & Chr(13) & Chr(10) & "Nom: " & Result(1) & Chr(13) & Chr(10) & "Projet : " & Result(2) & Chr(13) & Chr(10) & "Period: " & Result(3))

Ceci étant dit j'ai désormais un soucis car j'aimerais créer un seul mail avec les différentes personnes et tous les fichiers

une idée svp?

With Olmail

.To = Result(0) & "." & Result(1) & "@mail.fr"
.Subject = "Grant Office Reminders"
.body = "Projet: " & Result(2) & vbCrLf & vbCrLf & "Fin de période: " & fin_periode & vbCrLf & vbCrLf & "Période concernée: " & Result(3) & vbCrLf & vbCrLf & "Ceci est un mail automatique de mon fichier de suivi."
.Attachments.Add (destination & fichier)
.DeleteAfterSubmit = True
'    .Send
.display

Sub Grant_Reminders()
Dim spS As Worksheet
Dim spP As Range
Dim la As Range
Dim tblReport() As Variant
Dim project_ID As Variant
Dim period_ID As Variant
Dim acronym_Row As Variant
Dim acronym As Variant
Dim prem As String
Dim i As Long
Dim n As Long
ReDim Mailing(1 To 1)               'Déclaration d'un tableau dynamique (donc redimensionnable)
Const decalage As Integer = 7       '(de A à H)
Const tableName$ = "T_Reports"

 Dim Ol As New Outlook.Application
Dim Olmail As MailItem
Dim CurrFile As String
Set Ol = New Outlook.Application
Set Olmail = Ol.CreateItem(olMailItem)

  tblReport = Worksheets("Reporting").Range("A:J").Value
  For i = 1 To UBound(tblReport)
    If tblReport(i, 7) > Now And tblReport(i, 7) <= Now + 55 And tblReport(i, 10) = "N" Then
      project_ID = tblReport(i, 1)
      period_ID = tblReport(i, 2)
      acronym_Row = Application.Match(project_ID, Worksheets("Projects").Range("A:A"), 0)
      If Not IsError(acronym_Row) Then
        acronym = Worksheets("Projects").Cells(acronym_Row, 3).Value
        Set spS = ThisWorkbook.Worksheets("Staff")
        Set spP = spS.Range("A1:A" & spS.Range("A" & Rows.Count).End(xlUp).row)
        With spP
          Set la = .Find(project_ID, LookIn:=xlValues)
          If Not la Is Nothing Then
            prem = la.Address
            Do
              n = n + 1
              ReDim Preserve Mailing(1 To n)   'Redimentionnement du tableau (ne pas typer)
              If la.Offset(0, decalage) = period_ID Then Mailing(n) = spS.Cells(la.row, 4).Value & "/" & spS.Cells(la.row, 3).Value & "/" & acronym & "/" & period_ID

              Set la = .FindNext(la)
            Loop While la.Address <> prem
          End If
        End With
      End If
    End If
  Next i
  If n = 0 Then
    MsgBox "mailing est vide"
  Else

    For i = 0 To UBound(Mailing)
    i = i + 1

Result = Split(Mailing(i), "/")
'MsgBox ("Prenom: " & Result(0) & Chr(13) & Chr(10) & "Nom: " & Result(1) & Chr(13) & Chr(10) & "Projet : " & Result(2) & Chr(13) & Chr(10) & "Period: " & Result(3))

destination = ThisWorkbook.Path & "\Projects_Library\" & Result(2) & "-" & project_ID & "\Reporting\"
fichier = "FH (" & Result(2) & ")-P" & Result(3) & "-" & Result(0) & " " & Result(1) & " (PP)-vierge.xlsm"

With Olmail
.To = Result(0) & "." & Result(1) & "@mail.fr"
.Subject = "Grant Reminders"
.body = "Projet: " & Result(2) & vbCrLf & vbCrLf & "Fin de période: " & fin_periode & vbCrLf & vbCrLf & "Période concernée: " & Result(3) & vbCrLf & vbCrLf & "Ceci est un mail automatique de mon fichier de suivi."
.Attachments.Add (destination & fichier)
.DeleteAfterSubmit = True
'    .Send
.display

End With

    Next

  End If
End Sub

Bonjour,

tu as déjà résolu le schmilblick

.To = Result(0) & "." & Result(1) & "@mail.fr"

ou bien y a t'il un loup

Il faudrait aussi savoir comment est fait ton array Mailing(i)

Bonjour Steelson,

merci à vous de vous pencher sur mon soucis

mailing = prenom / nom / projet / periode concernée

dans mon exemple ici et dans mailing j'ai donc

mailing = ( prenom1 / nom1 / projet1 / periode concernée1) (prenom2 / nom2 / projet2 / periode concernée2)

mais mon .to ne prends que un par un et génère un mail pour chaqu'un d'entre eux alors que je voudrais un mail commun.

d'autant qu'a l'heure toutes les pièces jointes vont dans le mail de la 2ème personne meme si pour la premiere seule ses docs apparaissent...

ok, je comprends mieux le split ... je regarde

au passage, si tu fais ceci

For i = 0 To UBound(Mailing)
    i = i + 1

tu en prends un sur deux ! car for incrément déjà de lui-même

essaie ceci

destinataires = ""
For i = 0 To UBound(Mailing)
    Result = Split(Mailing(i), "/")
    destinataires = destinataires & Result(0) & " " & Result(1) & ";"
Next

With Olmail
    .To = destinataires
' .............
End With

s'il faut ajouter @gmail.com à tous il faudra le faire individuellement et mettre sans doute un point entre nom et prénom. Mis si les personnes sont déjà connues d outlook cela doit passer.

merci pour votre retour

néanmoins j'ai un soucis d'erreur d'exécution 9, l'indice n'appartient pas à la sélection

si je tente

destinataires = ""
For i = 0 To UBound(Mailing)
Result = Split(Mailing(i), "/")

j'ai direct un message d'erreur

si je mets

destinataires = ""
For i = 1 To UBound(Mailing)
Result = Split(Mailing(i), "/")

le premier resultat est reconnu mais pas le suivant qui génère le même code erreur

alros que si je fais comme à l'initial

' For i = 0 To UBound(Mailing)
' i = i + 1

alors là les deux sont reconnus.

donc j'ai tenté de continuer et cela fonctionne presque comme ceci sauf que concernant la pièce jointe je n'ai que celle de la 2eme personne...

    For i = 0 To UBound(Mailing)
    i = i + 1

Result = Split(Mailing(i), "/")
MsgBox ("Prenom: " & Result(0) & Chr(13) & Chr(10) & "Nom: " & Result(1) & Chr(13) & Chr(10) & "Projet : " & Result(2) & Chr(13) & Chr(10) & "Period: " & Result(3))

destination = ThisWorkbook.Path & "\Projects_Library\" & Result(2) & "-" & project_ID & "\Reporting\"
fichier = "FH (" & Result(2) & ")-P" & Result(3) & "-" & Result(0) & " " & Result(1) & " (PP)-vierge.xlsm"
destinataires = destinataires & Result(0) & "." & Result(1) & "@mail.fr;"

    Next
    With Olmail

.To = destinataires
.Subject = "Grant Office Reminders"
.body = "Projet: " & Result(2) & vbCrLf & vbCrLf & "Fin de période: " & fin_periode & vbCrLf & vbCrLf & "Période concernée: " & Result(3) & vbCrLf & vbCrLf & "Ceci est un mail automatique de mon fichier de suivi."
.Attachments.Add (destination & fichier)
.DeleteAfterSubmit = True
'    .Send
.display

End With

une idée svp?

en aveugle (sans fichier) c 'est pas simple !

je fais un essai

Si tes données sont bien comme ceci

Darkangel a écrit :

( prenom1 / nom1 / projet1 / periode concernée1) (prenom2 / nom2 / projet2 / periode concernée2)

Leur décomposition est comme cela

Sub decomposer()

mailing = Split(Cells(1, 1), ") (")

For i = 0 To UBound(mailing)
    result = Split(mailing(i), "/")
    Cells(i + 3, 1) = result(0)
    Cells(i + 3, 2) = result(1)
Next

End Sub

sinon, si ça coince, c'est que tu as un soucis avec une de tes données, ajoute un debug.print pour savoir qui ! et apriori cela doit bien être le cas

Darkangel a écrit :

le premier resultat est reconnu mais pas le suivant qui génère le même code erreur

merci à vous je vais examiner cela

néanmoins comme puis je également régler le problème de fichier?

merci par avance

Darkangel a écrit :

néanmoins comme puis je également régler le problème de fichier?

C'est nouveau ? tu n'en avais pas parlé jusqu'à maintenant ... (sauf incompréhension de ma part)

si:

donc j'ai tenté de continuer et cela fonctionne presque comme ceci sauf que concernant la pièce jointe je n'ai que celle de la 2eme personne..

mais peut importe, c'est juste que ca ne prends pas les deux fichiers des deux personnes de l'exemple

en l'occurrence je ne sais pas d'avance combien de personnes seront détectées

Sans fichier, sans données, c'est trop le brouillard. Désolé.

Bonjour Steelson

voici par conséquent un fichier test avec pièce jointe test retraçant le soucis

Sachant que 2 personnes sont détectées il faut le fichier propre à chacune des personnes

encore merci pour votre aide

bonne journée

je regarde, cela va prendre du temps car je sens que je vais être coupé !

en faisant cela

tblReport = Worksheets("Reporting").Range("A:J").Value

tu as 1048576 lignes

visible en ajoutant

Debug.Print LBound(tblReport), UBound(tblReport)

il vaut mieux faire

tblReport = Worksheets("Reporting").Range("A1").CurrentRegion.Value

et commencer i à 2

For i = 2 To UBound(tblReport) ' on ne prend pas les en-têtes

je poursuis ...

erreur déjà signalée :

    For i = 0 To UBound(mailing)
    i = i + 1

cela revient à faire une ligne sur 2

for incrémente de lui-même i, pas besoin d'ajouter une ligne

erreur déjà signalée :

oui à et à juste titre merci mais je voulais d'abord résoudre le problème de fichier avant de corriger cela, désolé

j'ai bien intégré votre première correction, merci

tblReport = Worksheets("Reporting").Range("A1").CurrentRegion.Value
For i = 2 To UBound(tblReport)

mailing commence à 1, c'est toi qui l'a défini

    For i = 1 To UBound(mailing)

en fait, tu ajoutes des destinataires via n=n+1 dans la boucle de recherche !

            Do
              n = n + 1
              ReDim Preserve mailing(1 To n)   'Redimentionnement du tableau (ne pas typer)
              If la.Offset(0, decalage) = period_ID Then mailing(n) = spS.Cells(la.Row, 4).Value & "/" & spS.Cells(la.Row, 3).Value & "/" & acronym & "/" & period_ID
              Set la = .FindNext(la)
            Loop While la.Address <> prem

il ne faut le faire que si une valeur est trouvée, sinon tu as des mailing(i) vides ! voici ce que j'obtiens ...

 1            Frédéric/Nom1/Acronym/2
 2            
 3            Rosa/Nom2/Acronym/2

correction de la boucle

            Do
              If la.Offset(0, decalage) = period_ID Then
                n = n + 1
                ReDim Preserve mailing(1 To n)   'Redimentionnement du tableau (ne pas typer)
                mailing(n) = spS.Cells(la.Row, 4).Value & "/" & spS.Cells(la.Row, 3).Value & "/" & acronym & "/" & period_ID
              End If
              Set la = .FindNext(la)
            Loop While la.Address <> prem

attention, il faut aussi ajouter n=0

  tblReport = Worksheets("Reporting").Range("A1").CurrentRegion.Value

  For i = 2 To UBound(tblReport) ' on ne prend pas les en-têtes
    If tblReport(i, 7) > Now And tblReport(i, 7) <= Now + 55 And tblReport(i, 10) = "N" Then

' ajout
      n = 0
' fin ajout

      project_ID = tblReport(i, 1)