Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Contribuez
Contribuez Placez ici vos codes, sources, trucs et astuces que vous souhaitez partager avec les membres du club.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
'
Vieux 02/09/2007, 03h09   #1
Expert Confirmé
 
Homme Philippe
ex Observeur CGG / Analyste prog.
Inscription : juin 2006
Messages : 1 719
Détails du profil
Informations personnelles :
Nom : Homme Philippe
Localisation : France, Finistère (Bretagne)

Informations professionnelles :
Activité : ex Observeur CGG / Analyste prog.

Informations forums :
Inscription : juin 2006
Messages : 1 719
Points : 3 666
Points : 3 666
Via CDO en cochant sous VBE Outils|Références Microsoft CDO for Exchange xxxx Library
A adapter à ton contexte,ici envoi de fichier Pdf
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
 
Sub Envoi_CDO1()
Dim CdoMessage As CDO.Message
Dim Fichier As Variant
 
    ChDir "C:\Documents and Settings\UserName\Mes documents\PdfOut"
    Fichier = Application.GetOpenFilename("Fichiers PDF (*.pdf), *.pdf")
 
    If Fichier = False Then Exit Sub
 
    Set CdoMessage = New CDO.Message
    With CdoMessage
        .Subject = "Exemple"
        .From = "xxxxx@wanadoo.fr"
        .To = "yyyyy@orange.fr"
        .CC = ""
        .BCC = ""
        .TextBody = "Texte dans le corps de message"
        .AddAttachment Fichier
        .Send
    End With
 
    Set CdoMessage = Nothing
End Sub
Ou sans rien cocher

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
 
Sub Envoi_CDO2()
Dim CdoMessage As Object
Dim Fichier As Variant
 
    ChDir "C:\Documents and Settings\UserName\Mes documents\PdfOut"
    Fichier = Application.GetOpenFilename("Fichiers PDF (*.pdf), *.pdf")
 
    If Fichier = False Then Exit Sub
 
    Set CdoMessage = CreateObject("CDO.Message")
    With CdoMessage
        .Subject = "Exemple"
        .From = "xxxxx@wanadoo.fr"
        .To = "yyyyy@orange.fr"
        .CC = ""
        .BCC = ""
        .TextBody = "Texte dans le corps de message"
        .AddAttachment Fichier
        .Send
    End With
 
    Set CdoMessage = Nothing
End Sub
kiki29 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/09/2007, 23h10   #2
Expert Confirmé
 
Homme Philippe
ex Observeur CGG / Analyste prog.
Inscription : juin 2006
Messages : 1 719
Détails du profil
Informations personnelles :
Nom : Homme Philippe
Localisation : France, Finistère (Bretagne)

Informations professionnelles :
Activité : ex Observeur CGG / Analyste prog.

Informations forums :
Inscription : juin 2006
Messages : 1 719
Points : 3 666
Points : 3 666
si tu veux envoyer la feuille active
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
35
36
37
38
39
40
41
42
43
 
Option Explicit
 
Sub Tst()
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim Temp As String
Dim CdoMessage As Object
Dim Fichier As String
 
    Set Sourcewb = ActiveWorkbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 
    Temp = ThisWorkbook.Path & Application.PathSeparator & "Toto.xls"
 
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
 
    Destwb.SaveAs Temp
    Fichier = Destwb.Path & Application.PathSeparator & Destwb.Name
    Destwb.Close
    Application.DisplayAlerts = True
 
    Set CdoMessage = CreateObject("CDO.Message")
    With CdoMessage
        .Subject = "Exemple"
        .From = "xxxxx@wanadoo.fr"
        .To = "yyyyy@hotmail.fr"
        .CC = ""
        .BCC = ""
        .TextBody = "Texte dans le corps de message"
        .AddAttachment Fichier
        .Send
    End With
 
    Application.ScreenUpdating = True
 
    Set CdoMessage = Nothing
    Kill Fichier
End Sub
kiki29 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 03/09/2007, 01h11   #3
Expert Confirmé
 
Homme Philippe
ex Observeur CGG / Analyste prog.
Inscription : juin 2006
Messages : 1 719
Détails du profil
Informations personnelles :
Nom : Homme Philippe
Localisation : France, Finistère (Bretagne)

Informations professionnelles :
Activité : ex Observeur CGG / Analyste prog.

Informations forums :
Inscription : juin 2006
Messages : 1 719
Points : 3 666
Points : 3 666
Pour le classeur complet
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
Option Explicit
 
Sub Tst_Wb()
Dim SourceWb As Workbook
Dim CdoMessage As Object
Dim Fichier As String
 
    Set SourceWb = ActiveWorkbook
    Fichier = ThisWorkbook.Path & Application.PathSeparator & "Toto.xls"
 
    SourceWb.SaveCopyAs Fichier
 
    Set CdoMessage = CreateObject("CDO.Message")
    With CdoMessage
        .Subject = "Exemple"
        .From = "xxxxx@wanadoo.fr"
        .To = "yyyyy@orange.fr"
        .CC = ""
        .BCC = ""
        .TextBody = "Texte dans le corps de message"
        .AddAttachment Fichier
        .Send
    End With
 
    Set CdoMessage = Nothing
    'Kill Fichier
End Sub
On pourra dans ce cas envisager d'envoyer le Classeur complet sans le code VBA
kiki29 est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité
Outils de la discussion



Fuseau horaire GMT +2. Il est actuellement 00h13.


 
 
 
 
Partenaires

Hébergement Web