[XL-2007] Envoi auto par e-mail fichier PDF [Résolu]

[catetesse]

Bonjour,

Je souhaite envoyer automatiquement par e-mail (via Outlook) un fichier pdf généré automatiquement par une macro et je n’y arrive pas.
Donc j’ai un fichier excel avec une macro qui l’enregistre au format PDF toujours dans le même dossier mais avec un nom différent.
Le fichier PDF est ouvert. Les adresses e-mails sont différentes selon les transporteurs : elles sont présentent dans mon fichier Excel dans les cellules J6 et J7

Je connais ce système qui fonctionne très bien pour envoyer un fichier Excel :

Code :

1
2
3
4
5
6
7
Dim myadress(1 To 2)
Set mylst = ActiveSheet.Range("j6:j7")
Count = 1
For Each Envoi In mylst
If Len(Envoi) Then myadress(Count) = Envoi: Count = Count + 1
Next
ActiveWorkbook.SendMail Recipients:=Array(myadress(1), myadress(2)), Subject:="Ordre affrètement"

Existe-t-il la même chose pour un fichier PDF ?

Merci beaucoup pour votre aide.

Catherine

[kiki29]

Salut, faire une recherche sur le site car ce sujet a déjà été traité
http://www.google.fr/#sclient=psy-ab...w=1035&bih=724
à lire également http://excel.developpez.com/faq/?page=Messagerie

[catetesse]

En fait je ne sais pas si on peut compiler ces deux codes.

Ci-dessous l'enregistrement en PDF :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
 '   Enregistre en pdf l'ordre d'affrètement dans le dossier logistique
 
    Chemin = "\\Elcfr2\logistique\Ordres affrètements\Ordres en PDF\"
    Texte = Range("nom_transporteur") & " - " & Range("num_ordre")
    Application.DisplayAlerts = False
 
    ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, _
    Filename:=Chemin & Texte, _
    Quality:=x1QualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=True

je voudrais que l'envoi se fasse automatiquement après ces lignes.

Merci

J'ai cherché dans le forum mais je ne trouve pas de réponse qui corresponde vraiment à ce que je voudrais.

Je continue à chercher tout de même.

mais si quelqu'un a une idée ....

[kiki29]

Re, via CDO en adaptant http://excel.developpez.com/faq/?pag...ailCDOexchange

[catetesse]

J'ai essayé ce que vous m'avez conseillé :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Envoi2()
Dim CdoMessage As Object
Dim Fichier As Variant
 
    ChDir "C:\Documents and Settings\cetesse\Mes documents\PdfOut"
    Fichier = Application.GetOpenFilename("Fichiers PDF (*.pdf), *.pdf")
 
    If Fichier = False Then Exit Sub
 
    Set CdoMessage = CreateObject("CDO.Message")
    With CdoMessage
        .Subject = "OMG ordre affrètement"
        .From = "catherine.etesse@xxx.com"
        .To = "catherine.etesse@xxx.com"
        .CC = ""
        .BCC = ""
        .TextBody = "Ci-joint nouvel ordre"
        .AddAttachment Fichier
        .Send
    End With
 
    Set CdoMessage = Nothing
End Sub

Mais ça plante dès CHDIR.

par ailleurs les adresses e-mail changent : je ne veux pas qu'elles soient dans la macro.

Comment aller les chercher dans Excel ?

Merci

Catherine

Bonjour,

Malgré mes recherches dans les forums je n'arrive pas à faire ce que je veux.

Quelqu'un peut-il me guider dans la façon de procéder : la façon dont je veux le faire n'est peut-être pas possible ; mais il existe sûrement un moyen.

Si quelqu'un peut m'aider ....

merci


Catherine

[bbil]

Envoyé par catetesse

J...

Mais ça plante dès CHDIR.
...

Et tu plante quoi ?

pas de messages ?

[kiki29]

Salut, à consulter également http://excel.developpez.com/faq/?page=Messagerie
http://excel.developpez.com/faq/?pag...urExecutionCDO
une autre possibilté via une recherche sur le site de Ron de Bruin

En PJ un embryon de solution à adapter

[patricktoulon]

bonjour

regarde par ici

au plaisir

[catetesse]

Bonjour à tous,

Grâce à vos conseils j'ai progressé.

Voici ce qui fonctionne :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub Envoi_ordre()
 
    Dim Chem As String, Fich As String, Dest1 As String, Dest2 As String
    Dim oApp As Object, oMail As Object
'Recherche fichier
 Sheets("Ordre").Select
 ActiveSheet.Unprotect
 
 
With Sheets("Ordre")
    Chem = .Range("x4")
    Fich = .Range("x6") & ".pdf"
    Dest1 = .Range("j6")
    Dest2 = .Range("j7")
End With
 
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
 
With oMail
    .To = Dest1
    .CC = Dest2
    .BCC = ""
    .Subject = "Affrètement XXX"
    .HTMLBody = "Bonjour, vous trouverez ci joint un nouvel ordre d'affrètement"
    .Attachments.Add (Chem & Fich)
    .Send
End With
 
Set oMail = Nothing
Set oApp = Nothing
 
 
End Sub

Merci et bonne journée

Catherine