Discussion :

[will-1981]

Bonjour,

Je souhaite envoyer une feuille que je copie dans un autre classeur par le biais d'Outlook. J'ai essayé différente chose mais ca n'envoie rien.

Voici mon code, j'ai l'impression que j'en suis pas loin.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub envoimail()
 
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim fichiers As String
Dim i As Integer
Dim path As String
 
service = InputBox("Quelle est le nom de votre service ?", "Service")
semaine = ActiveSheet.Range("C3").Value
'Application.DisplayAlerts = False
    Sheets("Planning hebdo").Copy
    ChDir "X:\EFFECTIFS\2014\Sauvegarde planning à 2 jours maxi"
    ActiveWorkbook.SaveAs Filename:="X:\EFFECTIFS\2014\Sauvegarde planning à 2 jours maxi\liste de recensement " & service & " " & semaine & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
'Application.DisplayAlerts = True.
 
Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)
 
fichiers = "X:\EFFECTIFS\2014\Sauvegarde planning à 2 jours maxi\liste de recensement " & service & " " & semaine & ".xlsx"""
  If fichiers = "" Then Exit Sub
 
With oBjMail
    .To = "mon adresse mail"
    .Subject = "Liste de recensement de la " & semaine & " du service " & service
    .Body = "Bonjour, " & _
            vbCrLf & vbCrLf & _
            "Ci-joint la liste de recensement du personnel de mon secteur " & service & _
            vbCrLf & vbCrLf & _
            "Bonne réception."
    .Attachments.AddItem fichier
    .Display
    .send
End With
 
    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
 
End Sub

Pouvez vous m'aider,
Merci

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub envoiermail()
Dim fichiers As String
Dim i As Integer
Dim path As String
Dim txtBody As String
service = InputBox("Quelle est le nom de votre service ?", "Service")
semaine = ActiveSheet.Range("C3").Value
'Application.DisplayAlerts = False
    Sheets("Planning hebdo").Copy
    ChDir "X:\EFFECTIFS\2014\Sauvegarde planning à 2 jours maxi"
    ActiveWorkbook.SaveAs Filename:="X:\EFFECTIFS\2014\Sauvegarde planning à 2 jours maxi\liste de recensement " & service & " " & semaine & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
'Application.DisplayAlerts = True.
 fichiers = "X:\EFFECTIFS\2014\Sauvegarde planning à 2 jours maxi\liste de recensement " & service & " " & semaine & ".xlsx"""
  If fichiers = "" Then Exit Sub
txtBody = "Bonjour, " & _
            vbCrLf & vbCrLf & _
            "Ci-joint la liste de recensement du personnel de mon secteur " & service & _
            vbCrLf & vbCrLf & _
            "Bonne réception."
 EnvoiMail_Outlook "Liste de recensement de la " & semaine & " du service " & service, txtBody, "mon adresse mail", Pj:=fichiers
End Sub
 
Sub EnvoiMail_Outlook(Sujet As String, Message As String, Destinataire As String, Optional DestinataireCopy As String, Optional DestinataireCopyCacher As String, Optional Pj As String = "")
Set ObjOutlook = CreateObject("Outlook.application")
Set MailObj = ObjOutlook.CreateItem(0)
With MailObj
    .To = Destinataire
    .cc = DestinataireCopy
    .BCC = DestinataireCopyCacher
    .Subject = Sujet
    .BodyFormat = 2
    .HTMLBody = Message
    If Trim("" & Pj) <> "" Then
        p = Split(Pj & ";", ";")
        For i = 0 To UBound(p)
            If Trim("" & p(i)) <> "" Then .Attachments.Add Trim("" & p(i))
        Next
    End If
    '.Display 'Can be .Send but prompts for user intervention before sending without 3rd party software like ClickYes
    .SEND
End With
End Sub

[will-1981]

Merci pour ton aides,

On va plus loin mais j'ai ce message qui apparait. Je pense que ça fait suite au fait que le fichier qui a été generé ne comporte plus de macro (du moins Excel me pose la question si je veux l'enregistrer avec macro) je réponds non.


Qu'est ce que tu en penses ?

Merci,
Will

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub envoiermail()
Dim fichiers As String
Dim i As Integer
Dim path As String
Dim txtBody As String
service = InputBox("Quelle est le nom de votre service ?", "Service")
semaine = ActiveSheet.Range("C3").Value
'Application.DisplayAlerts = False
    Sheets("Planning hebdo").Copy
    ChDir "X:\EFFECTIFS\2014\Sauvegarde planning à 2 jours maxi"
    fichiers = "X:\EFFECTIFS\2014\Sauvegarde planning à 2 jours maxi\liste de recensement " & service & " " & semaine & ".xlsx"
     ActiveWorkbook.SaveAs Filename:=fichiers, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
'Application.DisplayAlerts = True.
txtBody = "Bonjour, " & _
            vbCrLf & vbCrLf & _
            "Ci-joint la liste de recensement du personnel de mon secteur " & service & _
            vbCrLf & vbCrLf & _
            "Bonne réception."
 EnvoiMail_Outlook "Liste de recensement de la " & semaine & " du service " & service, txtBody, "mon adresse mail", Pj:=fichiers
End Sub

[will-1981]

Non ca ne fonctionne pas, j'ai pas le même message par contre ou disons pas tout a fait le même.



Merci

[Invité]

un autre essai?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub envoiermail()
Dim fichiers As String
Dim i As Integer
Dim path As String
Dim txtBody As String
service = InputBox("Quelle est le nom de votre service ?", "Service")
semaine = ActiveSheet.Range("C3").Value
'Application.DisplayAlerts = False
    'Sheets("Planning hebdo").Copy
     fichiers = "X:\EFFECTIFS\2014\Sauvegarde planning à 2 jours maxi\liste de recensement " & service & " " & semaine & ".xlsx"
    ActiveWorkbook.SaveAs FileName:=fichiers, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    'ActiveWindow.Close
'Application.DisplayAlerts = True.
 
  If fichiers = "" Then Exit Sub
txtBody = "Bonjour, " & _
            vbCrLf & vbCrLf & _
            "Ci-joint la liste de recensement du personnel de mon secteur " & service & _
            vbCrLf & vbCrLf & _
            "Bonne réception."
 EnvoiMail_Outlook "Liste de recensement de la " & semaine & " du service " & service, txtBody, "mon adresse mail", Pj:=fichiers
End Sub
 
Sub EnvoiMail_Outlook(Sujet As String, Message As String, Destinataire As String, Optional DestinataireCopy As String, Optional DestinataireCopyCacher As String, Optional Pj As String = "")
Set ObjOutlook = CreateObject("Outlook.application")
Set MailObj = ObjOutlook.CreateItem(0)
With MailObj
    .To = Destinataire
    .cc = DestinataireCopy
    .BCC = DestinataireCopyCacher
    .Subject = Sujet
    .BodyFormat = 2
    .HTMLBody = Message
    If Trim("" & Pj) <> "" Then
        p = Split(Pj & ";", ";")
        For i = 0 To UBound(p)
            If Trim("" & p(i)) <> "" Then .Attachments.Add Trim("" & p(i))
        Next
    End If
    '.Display 'Can be .Send but prompts for user intervention before sending without 3rd party software like ClickYes
    .SEND
End With
End Sub

[will-1981]

Super ça fonctionne parfaitement, tu vas peut etre t'enervé quand je vais te dire que la deuxiemen fois j'avais oublié de remettre mon adresse mail.

autant pour moi, en tout cas c'est ta derniere solution qui fonctionne.

J'ai pas vu ce que tu as changé, si tu veux me le dire. Je me sentirais mon ignorant.

En tout cas, merci beaucoup.

Will

[Invité]

d’abord j'ai ajouté un fonction pour envoyer les mail. ça ne veut pas dire que ce que tu avais fait ne fonctionnait pas mais je ne n’embête j'ai un truc qui marche alors je le colle sans analyser cette partie!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub EnvoiMail_Outlook(Sujet As String, Message As String, Destinataire As String, Optional DestinataireCopy As String, Optional DestinataireCopyCacher As String, Optional Pj As String = "")
Set ObjOutlook = CreateObject("Outlook.application")
Set MailObj = ObjOutlook.CreateItem(0)
With MailObj
    .To = Destinataire
    .cc = DestinataireCopy
    .BCC = DestinataireCopyCacher
    .Subject = Sujet
    .BodyFormat = 2
    .HTMLBody = Message
    If Trim("" & Pj) <> "" Then
        p = Split(Pj & ";", ";")
        For i = 0 To UBound(p)
            If Trim("" & p(i)) <> "" Then .Attachments.Add Trim("" & p(i))
        Next
    End If
    '.Display 'Can be .Send but prompts for user intervention before sending without 3rd party software like ClickYes
    .SEND
End With
End Sub

en suite tu enregistrais ton fichier mais tu ne récupérais pas le même nom pour la pièce jonte!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Filename:="X:\EFFECTIFS\2014\Sauvegarde planning à 2 jours maxi\liste de recensement " & service & " " & semaine & ".xlsx"
fichiers = "X:\EFFECTIFS\2014\Sauvegarde planning à 2 jours maxi\liste de recensement " & service & " " & semaine & ".xlsx"""

j'ai donc choisi de nommer ton fichier avant la sauvegarde ainsi si tu te trompe dans le nom du fichier au-moins tu te trompe partout!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
fichiers = "X:\EFFECTIFS\2014\Sauvegarde planning à 2 jours maxi\liste de recensement " & service & " " & semaine & ".xlsx"
ActiveWorkbook.SaveAs Filename:=fichiers, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 EnvoiMail_Outlook "Liste de recensement de la " & semaine & " du service " & service, txtBody, "mon adresse mail", Pj:=fichiers

et enfin j'ai mis en commentaire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 'ActiveWindow.Close

qui ferme ton fichier avant l’arrêt complet de l'appareil!