Envoyer via la macro un PJ dans Windows live mail

**liop49** · 31/03/2011, 14h37

Bonjour,

Je viens d'acquérir un PC sous Windows7. J'ai une macro sous Excel qui me permettait d'envoyer en automatique un email avec une pièce jointe. Le hic c'est que la macro était adaptée pour OutlookExpress sauf que sous Windows 7, OutlookExpress n'existe plus !!!!

J'utilise Windows Live Mail pour l'envoi des emails sauf que mon code ne fonctionne plus ou du moins il fonctionne mais la pièce jointe ne suit pas.

Voici le code sous Windows XP avec Pack Office 2007 et Outlook Express:

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
        If Response = vbYes Then    ' L'utilisateur a choisi Oui.
            adresse = "toto@free.fr"
            sujet = "Bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")"
            texte = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint le bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")" & vbCrLf & vbCrLf & vbCrLf & "Bonne réception." & vbCrLf & vbCrLf & vbCrLf & Representant
 
            Shell "c:\Program Files\Outlook Express\msimn.exe " & "/mailurl:mailto:" & _
            adresse & "?subject=" & sujet & "&Body=" & texte & ""
            SendKeys "%I" & "p" & nomfich & "~"
                    'Signification des caractères après "SendKeys":
                    '* %I et P = Insertion de la pièce jointe dans Outlook Express. (%=Alt)
                    '* ~ = Validation. (~=Entrée)
                    '* %S = Envoyer.
        Else
            MsgBox ("L'envoi du bordereau n'a pas eu lieu")
            End
 
        End If

Voici le nouveau code sous Windows 7 avec Pack Office 2010 et Windows Live mail :

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
        If Response = vbYes Then    ' L'utilisateur a choisi Oui.
            adresse = "toto@free.fr"
            sujet = "Bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")"
            texte = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint le bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")" & vbCrLf & vbCrLf & vbCrLf & "Bonne réception." & vbCrLf & vbCrLf & vbCrLf & Representant
 
            Shell "c:\Program Files (x86)\Windows Live\Mail\wlmail.exe " & "/mailurl:mailto:" & _
            adresse & "?subject=" & sujet & "&Body=" & texte & ""
            SendKeys "%I" & "p" & nomfich & "~"
                    'Signification des caractères après "SendKeys":
                    '* %I et P = Insertion de la pièce jointe dans Outlook Express. (%=Alt)
                    '* ~ = Validation. (~=Entrée)
                    '* %S = Envoyer.
        Else
            MsgBox ("L'envoi du bordereau n'a pas eu lieu")
            End
 
        End If

Ca semble bloquer sur le SendKeys

Est ce que quelqu'un peut m'aider ?

Vous remerciant par avance,

Nicolas

**Theze** · 31/03/2011, 22h41

Bonsoir,

Pourquoi ne pas utiliser Outlook ?

Hervé.

**liop49** · 31/03/2011, 23h21

parce que !!!!!!

Outlook est payant et je suis sur windows live mail donc je cherche une solution avec ce logiciel.

Est ce que quelqu'un peux m'aider où dois-je attendre la prochaine question :
"Pourquoi tu as changé de PC ?"

Vous remerciant par avance

Nico

**casefayere** · 31/03/2011, 23h55

Bonsoir,
je ne sais pas spécifiquement avec windows live mais tu dois pouvoir envoyer en direct sans recourir ni à Outlook, ni windows mail, ni Windows live, je t'envoie en brut un code que tu pourras adapter en fonction de mes remarques intégrées à celui-ci :

Après avoir ajouté la référence "Microsoft CDO for Windows 2000 Library" dans l'éditeur VBA

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
Sub mail_en_direct()
Const cdoBasic = 1
Dim admail As String, i As Integer
Dim messmail As String, secours As String
Dim expediteur As String
   On Error Resume Next
      expediteur = InputBox("Adresse mail de l'Expéditeur", "ADRESSE ELECTRONIQUE", "ton adresse mail")
      admail = InputBox("choisir le destinataire", "DESTINATAIRE", "adresse du destinataire")
      messmail = "Bonjour," & vbCrlf & vbCrlf & "Veuillez trouver ci-joint le bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")" & vbCrlf & vbCrlf & vbCrlf & "Bonne réception." & vbCrlf & vbCrlf & vbCrlf & Representant
   With CreateObject("CDO.Message")
   If Err Then
      secours = MsgBox("Problème de CDO non installé sur le serveur")
      Exit Sub
   Else
      .From = expediteur
      .To = admail
      '.Bcc = ""
      .Subject = "Bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")"
      .TextBody = messmail
      .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
      .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = expediteur
      .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "ton passeport windows live mail"
      .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
      .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.ton serveur.fr" 'attention
      .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
      .Configuration.Fields.Update
      .AddAttachment fichierJoint 'variable pourton fichier joint
      .Send
      If Err Then MsgBox "Le message n'a pas pu être expédié."
   End If
   On Error GoTo 0
End With
 
MsgBox "le fichier a logiquement été envoyé"
End Sub

J'espère que ça ira car j'ai supprimé des lignes de code qui me semblaient inutiles pour toi

**liop49** · 01/04/2011, 00h19

Bonsoirr

Merci pour cette réponse qui va je l'espère me faire avancer.Par contre 2 choses :

- J'avais bien identifié cette fonction mais a priori, je ne peux pas avoir de trace dans ma boite d'envoi. Est ce exacte ?
- Sur ton code, pas de pb sauf qu'il me dit les deux dernièrs "msgbox" c'est à dire

"Le message n'a pas pu être expédié."

puis

"le fichier a logiquement été envoyé"

et a priori sauf embouteillage dans les serrveurs, l'email n'est pas arrivé !

Te remerciant encore pour ton aide et je reste à l'écoute de ton éventuel retour,

Merci encore

nico

**casefayere** · 01/04/2011, 00h26

J'ai raccourci mon code mais à l'origine je l'envoyais 2 fois une fois pour le destinataire et une fois dans ma propre boite pour vérif, avec une boucle. Je veux bien te l'envoyer comme à l'origine mais plus le temps de changer les termes que tu devrais adapter. Et certaines de mes variables sont "Public" donc déclarées ailleurs dans le projet, à toi également d'adapter.

PS : tu as les deux messages car j'ai oublié un "Exit Sub" après le premier

Voici le code avec la boucle :

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
44
45
46
47
48
Sub mail_en_direct()
Const cdoBasic = 1
Dim admail As String, i As Integer
Dim messmail As String, secours As String
Dim expediteur As String
For i = 1 To 2
   On Error Resume Next
   If i = 1 Then
      expediteur = InputBox("Adresse mail de l'Expéditeur", "ADRESSE ELECTRONIQUE", "toto@orange.fr")
      admail = InputBox("choisir le destinataire", "DESTINATAIRE", "machin@free.fr")
      messmail = "Bonjour,et ton message"
   Else
      admail = expediteur 'pour se l'envoyer à soi-même en verification
      messmail = "ATTENTION !, ceci est une copie du message envoyé, pour controle"
   End If
   With CreateObject("CDO.Message")
      If Err Then
         'ci-dessous, j'ai prévu d'envoyer avec Outlook en cas d'echec, tu pourras supprimer jusqu'aux asterisques ou adapter
         secours = MsgBox("Problème de CDO non installé sur le serveur WEB" & Chr(10) & "Envoyer avec OUTLOOK ?", vbOKCancel)
         If secours = 1 Then
            Call mail_par_outlook: Exit Sub
         Else
            Exit Sub
         End If
      '**********************************************
      Else
         .From = expediteur
         .To = admail
         '.Bcc = ""
         .Subject = "TON SUJET"
         .TextBody = messmail
         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = expediteur
         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "TON MOT DE PASSE DE COURRIEL"
         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.ton courrier sortant.fr"
         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
         .Configuration.Fields.Update
         If i = 2 Then MsgBox "le fichier suivant sera joint au message => " & fichierJoint
         .AddAttachment fichierJoint 'ta variable représentant le fichier joint éventuel
         .Send
         If Err Then MsgBox "Le message n'a pas pu être expédié.": Exit Sub
      End If
      On Error GoTo 0
   End With
Next i
MsgBox "le fichier a logiquement été envoyé"
End Sub

surveilles ces lignes :

Code :

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

  .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "TON MOT DE PASSE DE COURRIEL"

et

Code :

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

     .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.ton courrier sortant.fr"

**liop49** · 01/04/2011, 11h39

tu es un pro casefayere

J'ai bidouillé (pas grand chose en fait car tu avais tu bien expliqué) et çà marche au top

Merci encore

Nicolas

**patricktoulon** · 02/04/2011, 15h31

bonjour

sinon tu a mon formulaire dans les contributions

le lien est dans ma signature

au plaisir

**liop49** · 04/04/2011, 23h22

Bonsoir,

J'ai du faire une erreur quelque part depuis vendredi dernier car le code ne fonctionne plus !!!!

Voici le code bidouillé (merci de ne pas rire

), j'ai masqué quelques infos perso pour éviter tout problème :

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
Sub EnvoiMail()
  Dim nomfich As String
  Dim nomfich2 As String
  Dim i As Integer
    Dim cellule As String
    Dim onglet As Worksheet
    Dim Cancel As Boolean
    Dim myrep, adresse, sujet, texte, Msg, Style, Title, Response, MyString
 
Const cdoBasic = 1
Dim destinataire As String, j As Integer
'Dim texte As String,
Dim secours As String
Dim expediteur As String
 
 
    Msg = "Il faut enregistrer le fichier avant l'envoi" & vbCrLf & vbCrLf & "Confirmez-vous l'enregistrement ?"
    Style = vbYesNo + vbInformation    ' Définit les boutons.
    Title = "Enregistrement du bordereau de visites"    ' Définit le titre.
 
    Response = MsgBox(Msg, Style, Title) ' Affiche le message.
 
    If Response = vbYes Then    ' L'utilisateur a choisi Oui.
 
 
        If Dir(Dossier, vbDirectory) <> "" Then
            enregistrer3
 
            For Each onglet In Application.ActiveWorkbook.Worksheets
             If onglet.Name <> "Fonctionnement" Then
                onglet.Select
 
                   For i = 10 To 30
                   cellule = ("I" & i)
                        If IsEmpty(Range("I" & i)) Then
                            If IsEmpty(Range("A" & i)) Then
 
                            Else
                                MsgBox ("Il faut absolument que l'observation d'une visite soit renseignée!" & vbCrLf & vbCrLf & "Il faut remplir la cellule " & cellule)
                                Cancel = True
                                verif = Range("I" & i).Value
                                Exit Sub
                           End If
                         End If
                    Next i
            End If
 
            Next onglet
 
            If Not verif_Personne Then Exit Sub
 
            Sheets("Fonctionnement").Select
 
            If Not Onglets_2 Then Exit Sub
 
        Else
            Msg = "Il faut créer un dossier Bordereau de visites à la racine de d:\" & vbCrLf & vbCrLf & "Souhaitez-vous le créer ?"
            Style = vbYesNo + vbInformation    ' Définit les boutons.
            Title = "Dossier de sauvegarde des bordereaux de visites"    ' Définit le titre.
            Response = MsgBox(Msg, Style, Title) ' Affiche le message.
 
            If Response = vbYes Then    ' L'utilisateur a choisi Oui.
                MkDir (Dossier)
                Msg = "Le dossier Bordereau de visites a été correctement créé à la racine de d:\" & vbCrLf & vbCrLf & "Souhaitez-vous faire l'enregistrement ?"
                Style = vbYesNo + vbInformation    ' Définit les boutons.
                Title = "Demande de validation"    ' Définit le titre.
                Response = MsgBox(Msg, Style, Title) ' Affiche le message.
 
                If Response = vbYes Then
                    enregistrer
 
                Else
                    MsgBox ("L'enregistrement du bordereau n'a pas eu lieu")
                    Exit Sub
                End If
 
            Else
                MsgBox ("L'enregistrement du bordereau ne pourra pas se réaliser")
                Exit Sub
            End If
        End If
 
    Range("C5").Select
 
    Msg = "Confirmez vous l'envoi d'un email pour le fichier" & vbCrLf & fichier
    Style = vbYesNo + vbQuestion
    Title = "Confirmation envoi email"
    Response = MsgBox(Msg, Style, Title) ' Affiche le message.
 
    myrep = Dossier
    nomfich = myrep & fichier & ".xlsx"
    nomfich2 = Dir(myrep & "*" & fichier & "*.xlsx")
    'Range("L2").Select
    'Range("L2").Value = Representant
 
 
 
        If Response = vbYes Then    ' L'utilisateur a choisi Oui.
 
            'mail_en_direct
            For j = 1 To 2
                On Error Resume Next
                   If j = 1 Then
                      expediteur = "toto.vrp2@free.fr"
                      destinataire = "toto.fdv@free.fr"
                      texte = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint le bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")" & vbCrLf & vbCrLf & vbCrLf & "Bonne réception." & vbCrLf & vbCrLf & vbCrLf & Representant
                   Else
                      destinataire = expediteur 'pour se l'envoyer à soi-même en verification
                      texte = "ATTENTION !" & vbCrLf & vbCrLf & "Ceci est une copie du message envoyé à toto.fdv@free.fr:"
                   End If
                   With CreateObject("CDO.Message")  'il faut activer la référence dans outils : Microsoft CDO for Windows 2000 library
                      If Err Then
                         'ci-dessous, j'ai prévu d'envoyer avec Windows Live Mail en cas d'echec
                         secours = MsgBox("Problème de CDO non installé sur le serveur WEB" & Chr(10) & "Envoyer avec WINDOWS LIVE MAIL ?", vbOKCancel)
                         If secours = 1 Then
                            MsgBox "Il faudra ajouter la pièce jointe manuellement"
                            adresse = "toto.vrp2@free.fr"
                            sujet = "Bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")"
                            texte = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint le bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")" & vbCrLf & vbCrLf & vbCrLf & "Bonne réception." & vbCrLf & vbCrLf & vbCrLf & Representant
                            Shell "c:\Program Files (x86)\Windows Live\Mail\wlmail.exe " & "/mailurl:mailto:" & _
                            adresse & "?subject=" & sujet & "&Body=" & texte & ""
 
                         Else
                            Exit Sub
                         End If
                         ' fin de la sécurité
 
                      Else
                         .From = expediteur
                         .To = destinataire
                         '.Bcc = ""
                         .Subject = "Bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")"
                         .TextBody = texte
                         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
                         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = expediteur
                         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mon mot de passe de messagerie"
                         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"
                         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
                         .Configuration.Fields.Update
                         If j = 2 Then MsgBox "Le fichier suivant sera joint au message" & vbCrLf & vbCrLf & nomfich
                         .AddAttachment nomfich 'ta variable représentant le fichier joint éventuel
                         .Send
                         If Err Then MsgBox "Le message n'a pas pu être expédié.": Exit Sub
                      End If
                      On Error GoTo 0
                   End With
                Next j
                MsgBox "Le fichier a logiquement été envoyé et une copie a été adressée à l'adresse " & vbCrLf & vbCrLf & "cailleau.toto@free.fr"
 
 
            ' fin du sub mail_en_direct
 
 
        Else
            MsgBox ("L'envoi du bordereau n'a pas eu lieu")
            End
 
        End If
 
    Else
        MsgBox ("L'envoi du bordereau n'a pas eu lieu")
        End
 
    End If
 
    'Nouveau_Bordereau
 
End Sub

Il me met le message

"Le message n'a pas pu être expédié."

Pour info, j'ai essayé le petit fichier de Patrictoulon (pas mal le fichier d'ailleurs

).Et j'ai un message d'erreur après avoir fait les modifications qu'il faut au niveauu du serveur smtp. Voici le message d'erreur :

Erreur d'execution :'-2147220975 (80040211)

Le message n'a pas pu être envoyé vers le serveur SMTP. Le code d'erreur de transport était 0x800ccc6f. La réponse du serveur était 554 Suspicious message

Je ne sais pas si cela peut aider dans la réflexion mais je ne cherche pas à solutionner le problème obtenu via le prog de Patrictoulon mais uniquement celui de mon code bidouillé.

En espérant que quelqu'un puisse m'aider sachant que ce code a eu fonctionné maiss mais pour une raison qui m'échape, il ne foncctionne plus.

Merci

Nicolas

**liop49** · 05/04/2011, 12h02

Bonjour,

Je viens de faire des essais qui me posent problème.

1.
Dans ma messagerie (Window live mail) j'ai les paramètres suivants :
serveur pop => pop.free.fr (car j'ai une adresse en @free.fr)
serveur smtp => smtp.sfr.fr (car le PC sera branché sur une neuf box)

A noter qu'en me connectant en wifi dans un MacDo, je peux envoyer et recevoir des emails sans contraintes particulières.

Dans le code, j'ai mis smtp.sfr.fr en serveur smtp => l'email n'est pas envoyé.

2.
Dans ma messagerie (Window live mail) j'ai les paramètres suivants :
serveur pop => pop.free.fr (car j'ai une adresse en @free.fr)
serveur smtp => smtp.orange.fr (car sur cet essais je suis connecté à une livebox)

A noter qu'en me connectant en wifi dans un MacDo, je peux envoyer et recevoir des emails sans contraintes particulières.

Dans le code, j'ai mis smtp.orange.fr en serveur smtp => l'email est envoyé et bien réceptionné à l'adresse du destinataire.

Est ce que quelqu'un voit le problème ?

Par avance merci car là je commence à sécher !

Nicolas

**patricktoulon** · 05/04/2011, 17h10

bonjour

Code :

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

smtp.free.fr

le pop c'est que pour la musique

j'ai regardé ta macro pour envoyer un mail

le trois quard de ta configuration ne sert a rien

mot de passe inutile avec cdo

choisir le port(25 ou autre inutile ) surtout si au momment de l'envoi le port est utilisé
tu devrais regarder mon exemple dans les contribs la configuration serveur suffi
au plaisir

**liop49** · 05/04/2011, 19h55

Bonsoir Patricktoulon et le reste du monde

Comme indiqué dans le post précédent, ton code est top mais je ne l'avais pas utilisé car il me faisait tout changer et j'avais un message d'erreur. Mais comme tu insistes et comme je suis planté avec le code initial, j'ai tenté d'utiliser ton code

Voici la bidouille

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
Sub EnvoiMail()
  Dim nomfich As String
  Dim nomfich2 As String
  Dim i As Integer
    Dim cellule As String
    Dim onglet As Worksheet
    Dim Cancel As Boolean
    Dim myrep, adresse, sujet, texte, Msg, Style, Title, Response, MyString
 
Const cdoBasic = 1
Dim destinataire As String, j As Integer
'Dim texte As String,
Dim secours As String
Dim expediteur As String
Dim iMsg As Object, iConf As Object, Flds As Object
 
 
    Msg = "Il faut enregistrer le fichier avant l'envoi" & vbCrLf & vbCrLf & "Confirmez-vous l'enregistrement ?"
    Style = vbYesNo + vbInformation    ' Définit les boutons.
    Title = "Enregistrement du bordereau de visites"    ' Définit le titre.
 
    Response = MsgBox(Msg, Style, Title) ' Affiche le message.
 
    If Response = vbYes Then    ' L'utilisateur a choisi Oui.
 
 
        If Dir(Dossier, vbDirectory) <> "" Then
            enregistrer3
 
            For Each onglet In Application.ActiveWorkbook.Worksheets
             If onglet.Name <> "Fonctionnement" Then
                onglet.Select
 
                   For i = 10 To 30
                   cellule = ("I" & i)
                        If IsEmpty(Range("I" & i)) Then
                            If IsEmpty(Range("A" & i)) Then
 
                            Else
                                MsgBox ("Il faut absolument que l'observation d'une visite soit renseignée!" & vbCrLf & vbCrLf & "Il faut remplir la cellule " & cellule)
                                Cancel = True
                                verif = Range("I" & i).Value
                                Exit Sub
                           End If
                         End If
                    Next i
            End If
 
            Next onglet
 
            If Not verif_Personne Then Exit Sub
 
            Sheets("Fonctionnement").Select
 
            If Not Onglets_2 Then Exit Sub
 
        Else
            Msg = "Il faut créer un dossier Bordereau de visites à la racine de d:\" & vbCrLf & vbCrLf & "Souhaitez-vous le créer ?"
            Style = vbYesNo + vbInformation    ' Définit les boutons.
            Title = "Dossier de sauvegarde des bordereaux de visites"    ' Définit le titre.
            Response = MsgBox(Msg, Style, Title) ' Affiche le message.
 
            If Response = vbYes Then    ' L'utilisateur a choisi Oui.
                MkDir (Dossier)
                Msg = "Le dossier Bordereau de visites a été correctement créé à la racine de d:\" & vbCrLf & vbCrLf & "Souhaitez-vous faire l'enregistrement ?"
                Style = vbYesNo + vbInformation    ' Définit les boutons.
                Title = "Demande de validation"    ' Définit le titre.
                Response = MsgBox(Msg, Style, Title) ' Affiche le message.
 
                If Response = vbYes Then
                    enregistrer
 
                Else
                    MsgBox ("L'enregistrement du bordereau n'a pas eu lieu")
                    Exit Sub
                End If
 
            Else
                MsgBox ("L'enregistrement du bordereau ne pourra pas se réaliser")
                Exit Sub
            End If
        End If
 
    Range("C5").Select
 
    Msg = "Confirmez vous l'envoi d'un email pour le fichier" & vbCrLf & fichier
    Style = vbYesNo + vbQuestion
    Title = "Confirmation envoi email"
    Response = MsgBox(Msg, Style, Title) ' Affiche le message.
 
    myrep = Dossier
    nomfich = myrep & fichier & ".xlsx"
    nomfich2 = Dir(myrep & "*" & fichier & "*.xlsx")
    'Range("L2").Select
    'Range("L2").Value = Representant
 
 
 
        If Response = vbYes Then    ' L'utilisateur a choisi Oui.
 
            'mail_en_direct
            For j = 1 To 2
                On Error Resume Next
                   If j = 1 Then
                      expediteur = "toto@free.fr"
                      destinataire = "titi@free.fr"
                      texte = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint le bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")" & vbCrLf & vbCrLf & vbCrLf & "Bonne réception." & vbCrLf & vbCrLf & vbCrLf & Representant
                   Else
                      destinataire = expediteur 'pour se l'envoyer à soi-même en verification
                      texte = "ATTENTION !" & vbCrLf & vbCrLf & "Ceci est une copie du message envoyé à cailleau.fdv@free.fr:"
                   End If
 
Set iMsg = CreateObject("cdo.message")
Set iConf = CreateObject("cdo.configuration")
 
Set Flds = iConf.Fields
With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    'remplacez "smtp.nomserveur.fr" par le nom de serveur de votre FAI :
    'http://outlook.developpez.com/faq/index.php?page=Configuration#Paras_FAI
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"
    .Update '                                                                   /\
End With                                                            '          /
 '  ici tu dois metre le serveur corespondant a ton fournisseur d'acces______ /
 
With iMsg
    Set .Configuration = iConf
    .To = destinataire
    .From = destinataire
    .Subject = "Bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")"
    .TextBody = texte
 
End With
 
                         If j = 2 Then MsgBox "Le fichier suivant sera joint au message" & vbCrLf & vbCrLf & nomfich
                         .AddAttachment nomfich 'ta variable représentant le fichier joint éventuel
                         .Send
                         If Err Then MsgBox "Le message n'a pas pu être expédié.": Exit Sub
                      End If
                      On Error GoTo 0
                   End With
                Next j
                MsgBox "Le fichier a logiquement été envoyé et une copie a été adressée à l'adresse " & vbCrLf & vbCrLf & "toto@free.fr"
 
 
        Else
            MsgBox ("L'envoi du bordereau n'a pas eu lieu")
            End
 
        End If
 
    Else
        MsgBox ("L'envoi du bordereau n'a pas eu lieu")
        End
 
    End If
 
End Sub

lorsque je le lance il bloque sur :

Code :

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

.AddAttachment

et il me met le message suivant :

Erreur de compilation :
Référence incorrecte ou non qualifiée

Peux-tu ou pouvez vous m'aider car je commence à désespérer ?

Par aavance merci

Nico la loose

**patricktoulon** · 05/04/2011, 21h12

bonsoir

c'est tout bete une toute petite petite erreur

tu a ecris ca:

Code :

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

1
2
 nomfich = myrep & fichier & ".xlsx"
    nomfich2 = Dir(myrep & "*" & fichier & "*.xlsx")

alors a supposer que myrep soit "c:\mondossier "
le fichier s'apelle " toto" avec l'extention"xlsx"
ca donne
c:\mondossier toto.xlsx il manque un anti slach
donc ca donne ca:

Code :

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

1
2
nomfich = myrep & "\" & fichier & ".xlsx"
    nomfich2 = Dir(myrep & "\" & fichier & ".xlsx")

il faut faire attention quand tu utilise le "*" parce que

Code :

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

fichier & "*.xlsx"

donne "toto*xslx"

voila au plaisir

**liop49** · 05/04/2011, 23h08

Re

Merci pour ton retour

Pour la remarque

alors a supposer que myrep soit "c:\mondossier "

, la supposition n'est pas la bonne car myrep est égale alors a supposer que myrep soit "c:\mondossier\"

Concernant

il faut faire attention quand tu utilise le "*" parce que

fichier & "*.xlsx"

donne "toto*xslx"

, je ne vois pas le problème par rapport au message d'erreur car ce code permet de vérifier la présence ou non du fichier dans un répertoire.

Pour rappel, mon code bloque sur l'envoi du fichier en pièce jointe avec le message suivant

Erreur de compilation :
Référence incorrecte ou non qualifiée

sur le code suivant

Code :

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

.AddAttachment

Avec mes remerciements pour ceux qui prendrons la peine de lire

- soit le code du post de 19h55
- soit le code d'hier à 23h22 avec les essais postés à 14h09 aujourd'hui.

En effet, les 2 méthodes plantent donc il y a sûrement un point commun qui fait buger les 2 codes. Mais je n'arrive pas à voir !!!!

Nico

**casefayere** · 06/04/2011, 10h21

Bonjour Nico, re le forum,
as-tu vérifier la valeur de la variable "dossier" quand tu ecris

Code :

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

myrep = Dossier

si oui, cette valeur se termine t'elle par "\" sinon

Code :

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

nomfich = myrep & "\" & fichier & ".xlsx"

bonne journée

**liop49** · 06/04/2011, 10h53

Bonjour casefayere et les autres,

Oui la variable dossier à le \ intégré.

Aurais-tu (ou auriez-vous) une autre piste à mon problème ?

Merci

Nicolas

**casefayere** · 06/04/2011, 11h03

Je crois que je viens de voir, il manque un "with", et tu as end with donc "AddAttachment" ne veux plus rien dire

**liop49** · 06/04/2011, 11h06

Exacte !

Mais je viens de le supprimer le End With mais cela ne change pas mon pb.

Je vais voir pour refaire le code mais si tu identifies autre chose, je suis preneur.

Merci