VBA OFT plusieurs pieces jointes

[Bens7]

Bonjour a tous !
J'ai un tableau A1:M50
en C le nom du fichier (sans le .pdf)
J'ai un module qui ouvre un OFT pour chaque ligne separement et en pieces jointes place le fichier de C et.pdf
mon probleme est que je veux 1 seul mail qui insere toute les pieces jointes de la collonne en 1 seul mail pas un mail par fichier ...
voila je vous met le code de depart quand meme :
merci ...!

Sub MAILJULIEN()

Dim AppOut As Object
Dim oMailItem As Object
Dim NomModele As String
Set AppOut = CreateObject("Outlook.Application")

Derlig = Range("A:A").Find("*", , , , , xlPrevious).Row
NbLig = Range("A2:A" & Derlig).Rows.Count   'Nombre de ligne

'MsgBox (" Nombre de lignes ") & Derlig
'MsgBox (" Nombre de lignes") & NbLig

For i = 2 To NbLig + 1 'a modifier pour le nombre de lignes

NomModele = "C:\Documents and Settings\pc-maison\Bureau\RDV\EMAIL\PLANNING.oft"

Set oMailItem = AppOut.CreateItemFromTemplate(NomModele)
With oMailItem

    .To = "contact@moi.com"
    .Subject = "PLANNING DU" & [A1]
    .Attachments.Add "C:\Documents and Settings\pc-maison\Bureau\RDV\CLASSER\" & Cells(i, "C").Value & ".pdf"

    .Display
   '.Send

End With
Next i
End Sub

 

[Yaloo]

Re : VBA OFT plusieurs pieces jointes

Bonjour Bens, le forum,

Tu devrais faire une boucle avec tous tes fichiers dans l'envoi de ton mail.

Sub MAILJULIEN()
Dim AppOut As Object, oMailItem As Object, NomModele$
Set AppOut = CreateObject("Outlook.Application")
Derlig = Range("A:A").Find("*", , , , , xlPrevious).Row
NomModele = "C:\Documents and Settings\pc-maison\Bureau\RDV\EMAIL\PLANNING.oft"

Set oMailItem = AppOut.CreateItemFromTemplate(NomModele)
  With oMailItem
    .To = "contact@moi.com"
    .Subject = "PLANNING DU" & [A1]
      For i = 2 To Derlig
       .Attachments.Add "C:\Documents and Settings\pc-maison\Bureau\RDV\CLASSER\" & Cells(i, "C") & ".pdf"
      Next i
    .Display
    '.Send
  End With
End Sub

Si ça ne fonctionne pas, mets des fichiers bidons pour que l'on puisse t'aider.

A+

Martial

 

[Bens7]

Re : VBA OFT plusieurs pieces jointes

Bon bah Yaloo comme d'habitude parfait !!!
J'en profite pour la 2 eme etape 😱
que les pieces jointes qui se joignent dans le mail sont uniquement si dans la collonne D corespond a demain :
exemple:

C | D |
11111 17/10/13
22222 19/10/13
33333 17/10/13

Donc ya que le fichier 11111.pdf et 3333.pdf qui vont en pieces jointes .....
Mercfi encore

 

[Yaloo]

Re : VBA OFT plusieurs pieces jointes

Re,

Un truc comme ça :

Sub MAILJULIEN()
Dim AppOut As Object, oMailItem As Object, NomModele$, Répertoire$
Set AppOut = CreateObject("Outlook.Application")
  Derlig = Range("A:A").Find("*", , , , , xlPrevious).Row
  NomModele = "C:\Documents and Settings\pc-maison\Bureau\RDV\EMAIL\PLANNING.oft"
  Répertoire = "C:\Documents and Settings\pc-maison\Bureau\RDV\CLASSER\"
Set oMailItem = AppOut.CreateItemFromTemplate(NomModele)
   With oMailItem
     .To = "contact@moi.com"
     .Subject = "PLANNING DU" & [A1]
       For i = 2 To Derlig
       If Cells(i, 4) = Date + 1 Then .Attachments.Add Répertoire & Cells(i, "C") & ".pdf"
       Next i
     .Display
     '.Send
  End With
End Sub

Si ça ne fonctionne pas, mets des fichiers bidons pour que l'on puisse t'aider.

A+

Martial

 

[Bens7]

Re : VBA OFT plusieurs pieces jointes

bon bah que dire ... parfait ...
je m'excuse mais j'ai essayer de rajouter une pieces jontes de la sorte

Sub MAILJULIEN()
 Dim AppOut As Object, oMailItem As Object, NomModele$, Répertoire$
 Set AppOut = CreateObject("Outlook.Application")
   Derlig = Range("A:A").Find("*", , , , , xlPrevious).Row
   NomModele = "\\ben-pc\EMAIL\planning.oft"
   Répertoire = "\\ben-pc\RDV\CLASSER\"
 Set oMailItem = AppOut.CreateItemFromTemplate(NomModele)
    With oMailItem
      .To = "contact@moi.com"
      .Subject = "PLANNING DU" & [A1]
[COLOR="#FF0000"]      .Attachments.Add "\\ben-pc\RDV\" & "PLANNING DU" & [A1] & ".pdf"[/COLOR]
              For i = 2 To Derlig
        If Cells(i, 4) = Date + 1 Then .Attachments.Add Répertoire & Cells(i, "C") & ".pdf"
        Next i
      .Display
      '.Send
  End With
 End Sub

Mais ca passe pas peut etre que le fichier pdf est en verite comme ca PLANNING 16-10-2013.pdf
et dans la cellule [A1] 16/10/13

 

[Yaloo]

Re : VBA OFT plusieurs pieces jointes

Re,

Tu veux rajouter une autre pièce jointe ?

 

[Regueiro]

Re : VBA OFT plusieurs pieces jointes

Bonjour à Tous.

Code :

Mais ca passe pas peut etre que le fichier pdf est en verite comme ca PLANNING 16-10-2013.pdf
et dans la cellule [A1] 16/10/13

.Attachments.Add "\\ben-pc\RDV\" & "PLANNING DU" & [A1] & ".pdf"[/COLOR]

Enleve le DU
A remplacer par code ci dessous .

.Attachments.Add "\\ben-pc\RDV\" & [B]"PLANNING " [/B]& [A1] & ".pdf"

A+

 

[Bens7]

Re : VBA OFT plusieurs pieces jointes

Non c'est bon j'ai j'ai mis comme ca :
"\\BEN-PC\RDV\PLANNING " & Format(Now(), "dd-mm-yyyy") & ".pdf"

merci vraiment Yaloo

 

[Bens7]

Re : VBA OFT plusieurs pieces jointes

Yaloo desole mais j;'ai un bug dans le Macro qui creer le PLANNING DU 16-10-13
si le fichier existe deja ca bug et meme defois si le fichier n'existe pas ca bug :

Sub JULIEN()
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData Else
ActiveSheet.Range("$A$1:$M$638").AutoFilter Field:=6, Criteria1:="="

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="\\BEN-PC\RDV\PLANNING " & Format(Now(), "dd-mm-yyyy") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True

If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
MsgBox ("FICHIER LISTING PDF CREER")
End Sub

Merci !!!

 

[Yaloo]

Re : VBA OFT plusieurs pieces jointes

A quel endroit, ça bug ?

 

[Bens7]

Re : VBA OFT plusieurs pieces jointes

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="\\BEN-PC\RDV\PLANNING " & Format(Now(), "dd-mm-yyyy") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True

 

[Yaloo]

Re : VBA OFT plusieurs pieces jointes

N'as-tu pas un problème de répertoire ?

 

[Bens7]

Re : VBA OFT plusieurs pieces jointes

Je croit que j'ai trouver :
Filename:="\\BEN-PC\RDV\PLANNING " & Format(Now(), "dd-mm-yyyy") _
faut pas mettre le & .pdf mais ya pas un code plus simple pour sauvegarder en pdf je copie ce code a tous va

 

[Yaloo]

Re : VBA OFT plusieurs pieces jointes

Bonsoir Bens,

Tu dois pouvoir réduire à ça :

ActiveSheet.ExportAsFixedFormat xlTypePDF, "\\BEN-PC\RDV\PLANNING " & Format(Now(), "dd-mm-yyyy") & ".pdf"

A+