Ajout de piéce jointe avec nom changeant - macro mail excel

Résolu
mat_7055 -  
cs_Le Pivert Messages postés 8437 Statut Contributeur -
Bonjour à tous,

Je me permet de créer ce topic car je ne trouve pas de réponse à mon probléme dans les autres dicsussions: J'aimerais ajouter une PJ que je vient de créer à mon envoi de mail

Je précise que ma macro va créer plusieurs PJ pour plusieurs envoies d et je ne peux donc pas mettre de nom "fixe" sur ma PJ

Voici le code que j'utilise pour créer les PJ :

----------------------------
chemin = "le chemin voulu"
nomfic = "Relevé d'impayés" & " " & ActiveSheet.Range("b2").Value & " " & Format(Date, "mm-yyyy") & " " & x & ".xlsx"

ActiveWorkbook.SaveAs Filename:=chemin & nomfic, FileFormat:=xlWorkbookDefault
ActiveWorkbook.Close SaveChanges:=True

----------------------------

Par la suite je souhaite envoyer un mail par PJ, mais je me retrouve coincé lors de la definition de la PJ :

-------------------------
'PARTIE ENVOIE DE MAILS

Dim Dest As String
Dim CC As String
Dim Exp As String
Dim Suj As String
Dim Text As String

Dest = adresse mail
CC = "adresse mail"
Exp = "adresse mail"
Suj = "Relance facture."
Text = "Bonjour," & vbCrLf & vbCrLf & _
"texte." & vbCrLf & _
"texte." & vbCrLf & _
"texte" & vbCrLf & _
"texte." & vbCrLf & vbCrLf & _
"Cordialement." & vbCrLf & vbCrLf & _
"texte" & vbCrLf & _
"texte" & vbCrLf & _
"texte xx" & vbCrLf & _
" "

Dim Cdo_Message As Object
Set Cdo_Message = CreateObject("CDO.Message")

With Cdo_Message
.To = Dest
.From = Exp
.CC = CC
.Subject = Suj
.TextBody = Text
.AddAttachment nomfic

---------------------------------------
C'est sur la derniére partie .ADDattachment que je ne sais pas quoi mettre, j'ai essayé nomfic sans succés et également ("chemin du dossier" & nomfic & .xlsx")

Auriez-vous une solution pour moi?

Merci d'avance

3 réponses

  1. mat_7055
     
    Merci pour ton retour cs_Le Pivert,

    Je rencontre quelques soucis lors l'utilisation de cette filedialog, mais avant de te demander un petit coup de main ^^ j'aurais une question : cela va ouvrir une boite de dialogue pour trouver le chemin à chaque envoi ? ex : création de 100 PJ donc 100 boite de dialogue?

    J'ai intégré le code suivant :

    -----------------------------------------
    Dim lngCount As Long

    ' Open the file dialog
    With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Show

    ' Display paths of each file selected
    For lngCount = 1 To .SelectedItems.Count
    MsgBox .SelectedItems(lngCount)
    Next lngCount

    End With

    ---------------------------------------

    Quel ligne faut-il ajouter pour copier le chemin de le msgBox dans un variable que je pourrais reprendre dans mon .addatachement?
    0
    1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      Comme ceci:

      Sub UseFileDialogOpen()
        Dim lngCount As Long
       Dim nomfic As String
        ' Open the file dialog
          With Application.FileDialog(msoFileDialogOpen)
              .AllowMultiSelect = True
              .Show
       ' Display paths of each file selected
              For lngCount = 1 To .SelectedItems.Count
                   Range("A" & lngCount) = .SelectedItems(lngCount)
            nomfic = Range("A" & lngCount) & "; " + nomfic 'affiche les chemins séparés par point virgule
         Next lngCount
          nomfic = Left(nomfic, Len(nomfic) - 2) 'supprime dernier caractere
          MsgBox nomfic
          End With
       End Sub
      


      Tu auras juste à appeler la macro UseFileDialogOpen

      et ensuite tu pourras sélectionner le nombre de fichiers que tu désires, les chemins seront séparés par un point virgule

      @+ Le Pivert
      0
      1. mat_7055 > cs_Le Pivert Messages postés 8437 Statut Contributeur
         
        Merci, je vais essayer avec cette méthode

        Pour mon second probléme : la boucle, vaut-il meiux clore ce topic et en ouvrir un nouveau?
        0
      2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730 > mat_7055
         
        Ouvre un nouveau post, parce que là on ne va rien y comprendre
        0
  2. mat_7055
     
    J'ai réussià outrepasser le probléme en imposant un nom fixe à chaque PJ en fonction d'une valeur unique dans le fichier, par contre j'ai maintenant un probléme de boucle (ce que je comprend)

    Dans mon exemple j'ai 4 onglet à transformer en PJ et à envoyer par mail, le soucis est que la macro stoppe aprés le 1er mail

    Je précise qu'en ne renseignant que le code de création de PJ (sans la parties 'envoie de mail), la boucle fonctionne et me créer bien 4 PJ

    Le soucis vient quand je rajoute le code envoie de mail et qu'il s'arrête à 1PJ créer et 1 mail envoyé

    Ci dessous mon code :

    ---------------------

    Sheets("TCD").Select
    ActiveSheet.PivotTables("Tableau croisé dynamique1").ShowPages PageField:= _
    "MAIL"

    Do While ActiveSheet.Name <> "TCD" Or ActiveSheet.Name <> "base clients" Or ActiveSheet.Name <> "base TCD" Or ActiveSheet.Name <> "MACRO" Or ActiveSheet.Name <> "ISUZU" Or ActiveSheet.Name <> "ISUZU_2" Or ActiveSheet.Name <> "! Non Affecté !" Or ActiveSheet.Name <> "Impayés"

    Dim ws As Worksheet

    For Each feuille In ActiveWorkbook.Worksheets
    If feuille.Name = "TCD" Or feuille.Name = "base clients" Or feuille.Name = "base TCD" Or feuille.Name = "MACRO" Or feuille.Name = "ISUZU" Or feuille.Name = "ISUZU_2" Or feuille.Name = "! Non Affecté !" Or feuille.Name = "Impayés" Then

    Else

    feuille.Move

    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Columns("A:E").Select
    Columns("A:E").EntireColumn.AutoFit
    Range("B6").Select
    ActiveWindow.DisplayGridlines = False

    x = Range("b1").Value
    y = Range("b2").Value
    z = Range("d4").Value

    Range("b1").Select

    chemin = "chemin du fichier \"
    nomfic = y

    ActiveWorkbook.SaveAs Filename:=chemin & nomfic, FileFormat:=xlWorkbookDefault
    ActiveWorkbook.Close SaveChanges:=True

    'PARTIE ENVOIE DE MAILS

    Dim Dest As String
    Dim CC As String
    Dim Exp As String
    Dim Suj As String
    Dim Text As String

    Dest = adresse mail
    CC = adresse mail
    Exp = adresse mail
    Suj = "xxxxxxx" & y & ""
    Text = "Bonjour," & vbCrLf & vbCrLf & _
    "xxxxxxxx." & vbCrLf & _
    "xxxxxxxxx" & vbCrLf & _
    "." & vbCrLf & _
    "xxxxxxxx." & vbCrLf & vbCrLf & _
    "xxxxxx." & vbCrLf & vbCrLf & _
    "" & vbCrLf & _
    "xxxxxxxx" & vbCrLf & _
    "xxxxxxx xx" & vbCrLf & _
    " "

    Dim Cdo_Message As Object
    Set Cdo_Message = CreateObject("CDO.Message")

    With Cdo_Message
    .To = Dest
    .From = Exp
    .CC = CC
    .Subject = Suj
    .TextBody = Text
    .AddAttachment ("chemin du fichier\" & y & ".xlsx")

    .Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = xxxxxxx

    'nom du serveur smtp
    .Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxxxxxxxxx"

    'port du serveur smtp
    .Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") =xxxxxxxxx

    .Configuration.Fields.Update

    .Send
    End With

    Set Cdo_Message = Nothing
    MsgBox "Votre message a bien été envoyé", vbInformation
    Exit Sub

    err_handler:
    MsgBox "Le message n'a pas pu être envoyé. Merci d'utiliser le VPN.", vbCritical

    End If

    Next

    Loop

    End Sub
    ------------------------------------------------------------------------------------------------

    J'ai ajouté un do while + loop sans effet, je ne m'y prend surement pas de la bonne façon

    Une solution?
    0