Discussion :

[Nelson77]

Bonjour,

j'essaie depuis plusieurs jours de finaliser une macro qui permet d'envoyer un fichier excel par mail en automatique. J'ai fait le tour de forum sans succès.

Sur mon PC j'ai utilisé la méthode CDO sans spécifier de serveur et cela fonctionne sans soucis.

Mais la macro doit tourner de nuit sur un PC dédié, et en utilisant ma macro j'ai une erreur de "sendusing". Je pense que je dois spécifier le serveur SMTP mais je ne le connais pas.

J'ai donc utilisé sendkeys avec Outlook 2007 et cela fonctionne sur le PC dédié. Sauf que cela ne fonctionne pas avec un écran de veille, et donc de nuit.

Les contraintes du PC dédié (entreprise très verrouillée) sont:
- pas accès à internet, messagerie uniquement. Est-ce que CDO fonctionne dans ce contexte?
- écran de veille non modifiable 2h maxi
- je ne connais pas le serveur SMTP (celui de la boite)

Qqun a des suggestions? J'ai pensé à lancer des taches plannifées toutes les heures pour ne pas lancer l'écran de veille mais ça a l'air lourd et je suis même pas sûr que ça marche...

[Tradul]

Bonjour,

Essaye cette fonction VBA

Cordialement,

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
Function Send_Mail()
 
'--------------------------------------------------------------------------
' Déclaration des variables
'--------------------------------------------------------------------------
Dim Email As Object
Dim EmailMsg As Object
Dim Body_m As String
'--------------------------------------------------------------------------
' Definition des variables
'--------------------------------------------------------------------------
 
Set Email = CreateObject("Outlook.Application")
Set EmailMsg = Email.CreateItem(olMailItem)
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
Set Email = CreateObject("Outlook.Application")
Set EmailMsg = Email.CreateItem(olMailItem)
 
 
 
'--------------------------------------------------------------------------
' POUR MODIFIER LE SUJET ET LE DESTINATAIRE DU MAIL
'--------------------------------------------------------------------------
 
 EmailMsg.Subject = ""
 EmailMsg.To = ""
 EmailMsg.CC = ""
 
'----------------------------------------------------------------------------------------------------------------------------------------
 
 'EmailMsg.Attachments
 EmailMsg.Body = "ici"
 EmailMsg.Send
 
 
 '-------------------------------------------------------------------------
' Suppressions des OBJETS
'--------------------------------------------------------------------------
 
Set EmailMsg = Nothing
Set Email = Nothing
Set db = Nothing
Set rsv = Nothing
Set myOlApp = Nothing
Set myItem = Nothing
Set Email = Nothing
Set EmailMsg = Nothing
 
 
End Function

[Oliv-]

SAlut,
Peux tu utiliser les "Tâches planifiées" de windows ? si oui un vbscript peux faire l'affaire. celui de JC BELLAMY (Sendmail.vbs ) sera parfait.

tu paramètres la tâche avec le login et password adéquat.

dans sendmail si tu indiques .Item(cdoSendUsingMethod) = cdoSendUsingPickup '= 1
le vbs va récupérer les paramètres locaux de la messagerie c'est san doute ce que tu as fait.

il faut dans ce cas le mettre à 2 et indiquer le cdoSMTPServer et cdoSMTPServerPort

il y a une option pour s'authentifier du coup tu peux essayer le smtp d'un provider sur lequel tu as un compte de messagerie .

Code :

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

1
2
3
4
5
6
7
8
9
10
11
        '.Item(cdoSMTPAuthenticate) = cdoBasic
 
        ' IMPORTANT: Storing user names and passwords inside source code
        ' can lead to security vulnerabilities in your software. Do not
        ' store user names and passwords in your production code.
        '.Item(cdoSendUserName) = "username"
        '.Item(cdoSendPassword) = "password"
        '.Item (cdoSMTPUseSSL) = False 'Use SSL for the connection (True or False)
        '.Item(cdoURLProxyServer) = "server:80"
        '.Item(cdoURLProxyBypass) = "<local>"
        '.Item(cdoURLGetLatestVersion) = True

si tu vas dans les entêtes d'un des emails envoyé avec outlook sur ce pc tu pourras peut être voir le nom du serveur smtp ou son ip du moins.

[patricktoulon]

bonjour

la liste pour les POP,SMTP,IMAP

9 Telecom :
•Serveur POP : pop.neuf.fr
•Serveur SMTP : smtp.neuf.fr
•Serveur IMAP : imap.neuf.fr

9ONLINE :
•Serveur POP : pop.9online.fr
•Serveur SMTP : smtp.9online.fr

ALICE ADSL :
•Serveur POP : pop.alice.fr, pop.aliceadsl.fr
•Serveur SMTP : smtp.alice.fr , smtp.aliceadsl.fr
•Serveur IMAP : imap.aliceadsl.fr

AOL :
•Serveur POP : pop.aol.com (port=110)
•Serveur SMTP : smtp.neuf.fr
•Serveur IMAP : imap.fr.aol.com

ALTERN.ORG :
•Serveur POP : pop.altern.org ou altern.org
•Serveur SMTP : non
•Serveur IMAP : imap.altern.org (à modifier)

Bouygues BBOX :
•Serveur POP : pop3.bbox.fr
•Serveur SMTP : smtp.bbox.fr
•Serveur IMAP : imap4.bbox.fr

Bouygues Télécom :
•Serveur POP : pop.bouygtel.fr
•Serveur SMTP : smtp.bouygtel.fr
•Serveur IMAP : imap.bouygtel.fr

CARAMAIL :
•Serveur POP : pop.lycos.co.uk
•Serveur SMTP : smtp.lycos.co.uk
•Serveur IMAP : non

CEGETEL :
•Serveur POP : pop.cegetel.net
•Serveur SMTP : smtp.cegetel.net
•Serveur IMAP : imap.cegetel.net

CLUB INTERNET :
•Serveur POP : pop3.club-internet.fr
•Serveur SMTP : mail.club-internet.fr
•Serveur IMAP : imap.club-internet.fr

DARTY BOX (DARTYBOX) :
•Serveur POP : pop.dbmail.com
•Serveur SMTP : smtpauth.dbmail.com
•Plus d’informations : dartybox-news.fr/index.php?/pages/14-configuration-outlook-express

ESTVIDEO COMMUNICATION :
•Serveur POP : pop.evhr.net
•Serveur SMTP : smtp.evhr.net

FREE :
•Serveur POP : pop.free.fr
•Serveur SMTP : smtp.free.fr
•Serveur IMAP : imap.free.fr

FREESURF :
•Serveur POP : pop.freesurf.fr
•Serveur SMTP : smtp.freesurf.fr
•Serveur IMAP : imap.freesurf.fr

GAWAB :
•Serveur POP : pop.gawab.com
•Serveur SMTP : smtp.gawab.com
•Serveur IMAP : imap.gawab.com

GMAIL :
•Serveur POP : pop.gmail.com (sur activation de l’option POP de GMail)
•Serveur SMTP : smtp.gmail.com
•Serveur IMAP : imap.gmail.com
•Plus d’informations : gmail.google.com/support/bin/answer.py?answer=10350

HOTMAIL :
•Serveur POP : pop3.live.com (Port 995 avec connexion SSL)
•Serveur SMTP : smtp.live.com (Port 25 avec connexion SSL)
•Serveur IMAP : non
•Plus d’informations : Relever sa boîte Hotmail avec un logiciel de messagerie
•Marche à suivre pour configurer Mozilla Thunderbird avec Hotmail

IFrance :
•Serveur POP : pop.ifrance.com
•Serveur SMTP : smtp.ifrance.com
•Serveur IMAP : non

LA POSTE :
•Serveur POP : pop.laposte.net
•Serveur SMTP : smtp.laposte.net
•Serveur IMAP : imap.laposte.net

MAGIC ONLINE :
•Serveur POP : pop2.magic.fr
•Serveur SMTP : smtp.magic.fr
•Serveur IMAP : non

NERIM :
•Serveur POP : pop.nerim.net
•Serveur SMTP : smtp.nerim.net

NET COURRIER :
•Serveur POP : mail.netcourrier.com
•Serveur SMTP : idem que celui de votre FAI
•Serveur IMAP : mail.netcourrier.com

NOOS :
•Serveur POP : pop.noos.fr
•Serveur SMTP : mail.noos.fr
•Serveur IMAP : imap.noos.fr

Numéricable :
•Serveur POP : pop.numericable.fr
•Serveur SMTP : smtp.numericable.fr
•Serveur IMAP : imap.numericable.fr

ORANGE :
•Serveur POP : pop.orange.fr
•Serveur SMTP : smtp.orange.fr
•Serveur SMTP sécurisé : smtp-msa.orange.fr Port : 587 (activer l’authentification smtp)
•Serveur IMAP : imap.orange.fr
•Aide pour paramétrage FAI Orange avec messageries non Orange

OREKA :
•Serveur POP : mail.oreka.fr
•Serveur SMTP : mail.oreka.fr
•Serveur IMAP : non

SYMPATICO :
•Serveur POP : pop1.sympatico.ca
•Serveur SMTP : smtp1.sympatico.ca
•Serveur IMAP : non

SFR :
•Serveur POP : pop.sfr.fr
•Serveur SMTP : smtp.sfr.fr
•Serveur IMAP : imap.sfr.fr

TELE2 :
•Serveur POP : pop.tele2.fr
•Serveur SMTP : smtp.tele2.fr
•Serveur IMAP : non

TISCALI :
•Serveur POP : pop.tiscali.fr
•Serveur SMTP : smtp.tiscali.fr
•Serveur IMAP : non

TISCALI-FREESBEE :
•Serveur POP : pop.freesbee.fr
•Serveur SMTP : smtp.freesbee.fr
•Serveur IMAP : non

VOILA :
•Serveur POP : non
•Serveur SMTP : non
•Serveur IMAP : non

WANADOO :
•Serveur POP : pop.wanadoo.fr
•Serveur SMTP : smtp.wanadoo.fr
•Serveur IMAP : non

YAHOO :
•Serveur POP : pop.mail.yahoo.fr (sur activation de l’option POP3 de Yahoo) Port 995 Avec connexion SSL
•Serveur SMTP : smtp.mail.yahoo.fr Port 465 Avec connexion SSL
•Serveur IMAP : non

[patricktoulon]

RE
JE POURRAIS AJOUTER AUSSI QUE

beaucoup pensent que se servir du serveur smtp de leur boite perso ou pro
exemple:pour ceux qui ont une adresse du genre
toto@hotmail.fr
ou plus ancien
titi@msn.com
utilisent le serveur
smtp.live.com (Port 25 avec connexion SSL)'le serveur pour hotmail

et bien ca n'est pas la meilleur solution le plus rapide est d'utiliser le serveur de son "F.A.I"je suis chez free donc "SMTP.free.fr"
au plaisir

[Oliv-]

Si c est juste l envoi qui doit être à une certaine heure
Outlook dispose d une option d envoi diffère
Il doit être ouvert bien sur à l heure dite

[Nelson77]

Merci à vous tous, désolé pour la réponse tardive: j'ai eu une urgence et j'ai du mettre de côté ce sujet.

Pour clarifier:

J'ai accès aux taches plannifiées, en fait je lance la macro vers 5h du matin par tache plannifiée.

La macro récupére des données sur une base de données interne, la traite et met en forme dans un fichier excel. C'est une feuille de ce fichier excel que j'envoie par mail.

Je vais essayer vos solutions et je vous tiens informés.

Merci encore.

Solution de Tradul:

une fenêtre Outlook apparait demandant de cliquer.
Cela ne marchera pas car il faudrait un sendkeys et cela ne marche pas avec l'écran de veille

Solution de Oliv-

je sais pas comment fonctionne un script...
J'ai récupéré le fichier sendmail.vbs. Je modifie son contenu et je le mets telquel en tache plannifié?

Pour l'envoi différé outlook, le fichier change à chaque fois... Quoique, je peux ne mettre que le lien.

Par contre dans les 2 cas, le fichier peut partir alors qu'une erreur a empéché le traitement initial et donc envoyer un mauvais fichier?

[Oliv-]

Salut,
le vbs et le vba c'est très très proche tu trouveras sans peine des tutoriels sur le sujet.

Pour Programmer ton envoi tu créés un fichier "EnvoiMailDiffere.cmd"

dans lequel tu mets

Code :

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

d:\Document\sendmail_GS.vbs -e"Nelson77<nelson77@mail.com>" -d"mondestinataire@toto.com,monautredestinataire@toto.com" -o"Test envoi différé 2" -m"Bonjour \nà la ligne \nSignature" -pc:\mondossier\mapj.xls"

dans les tâches
dans exécuter tu auras : "d:\Document\EnvoiMailDiffere.cmd"
avec l'heure etc.. et surtout le login et password dans "exécuter en tant que"

[Nelson77]

ça marche! J'ai ajouté un cscript avant pour que ça marche mais c'est bon.

Si on veut envoyer à plein de dest, je suppose qu'il faut mettre des ";" entre chaque adresse?

Ca marche sur mon PC, mais demain je vois si c'est ok sur le PC fixe.

Croisons les doigts

mon code dans le .cmd:
@echo off
cscript "c:\documents and settings\desktop\sendmail.vbs" -enelson@mail.com -dnelson@mail.com -o"ddob22 objet" -m"yymesg22 message"

[Nelson77]

Patatra, je relance le .cmd ce matin. Et il ne se passe rien. Pas de messages d'erreur, pas de mail envoyé

Du coup, je ne sais pas quoi faire...

[Oliv-]

Peux tu faire des tests directement sur ce serveur genre déboggage vba à partir de xl?

[Nelson77]

Je rectifie, la macro marche toujours sur mon PC. C'est juste qu'il y a eu un plus long temps de traitement. J'ai reçu les mail 30 min plus tard.

Par contre sur le PC dédié, ça ne marche pas, j'ai le message:
sendmail.vbs (61,1) CDO.Message.1: The "SendUsind" configuration value is invalid.

Je comprends que je dois donc configurer le serveur smtp... Je ne veux pas passer par un autre smtp que celui de l'entreprise.

Oliv- sur le PC dédié on peut faire tout ce que l'on veut sauf surfer sur le web.

J'avais trouvé un post indiquant un moyen d'identifier le smtp, mais il fallait passer par un site internet. Donc ça ne marche pas!

Si j'ajoute le fameux

'.Item(cdoSMTPAuthenticate) = cdoBasic
'.Item(cdoSendUserName) = "username"
'.Item(cdoSendPassword) = "password"
'.Item (cdoSMTPUseSSL) = False 'Use SSL for the connection (True or False)
'.Item(cdoURLProxyServer) = "server:80"
'.Item(cdoURLProxyBypass) = "<local>"
'.Item(cdoURLGetLatestVersion) = True

le vbs trouve tout seul la bonne config?

Autre contrainte, on ne peut rien télécharger du web sur tous les PC (firewall) donc je n'ai pas de logiciel pour éditer le vbs.

je vais le télécharger chez moi et réessayer lundi

[Oliv-]

Salut,
Si tu peux faire des tests directement sur ce pc fixe, c'est mieux.

tu dois d'abord trouver le smpt, j'imagine que ton test qui a échoué utilisais cdoSendUsingMethod =cdoSendUsingPickup '= 1 ?? (tu le dis pas )


C'est la seule façon de récupérer pour cdo automatiquement les infos.

Sinon tu dois lui donner en dur le smtp et port.

Est ce que ce PCFIXE fait partie d'un domaine (active directory )?
est ce le même domaine que ton pc à toi et le même réseau ?

Comment est paramétré ton Outlook ? c'est un serveur EXCHANGE ou POP IMAP ... ?

En ouvrant "une invite de commande" tu peux faire

Code :

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

1
2
3
nslookup 
set type=mx
tondomaine.com

avec un peu de chance tu va recuperer le nom du serveur smtp

sinon fait PING (ou un telnet ) par exemple en testant smtp.tondomaine.com

[patricktoulon]

Bonjour

Si le problème est le Smtp différent au boulôt et chez toi et que tu connais le serveur de ta boîte,tu peux tester le nom de l'ordinateur avec (environ):
-si c'est le tien serveur: smtp1
-si c'est celui du boulôt: smtp2

Moi je fait comme çà
Au plaisir

[Nelson77]

Je suis chez moi donc je ne peux répondre qu'à certaines questions.

Je travaille sur le même réseau que le PC fixe. J'ai essayé des envois sur d'autres PC et un coup ça marche, un coup ça ne marche pas. J'ai regardé dans toutes les options possibles je ne vois pas de différences.

Je suis nul en messagerie (mon truc c'est excel), domaine & co, je ne sais pas si on est en exchange ou pop... On a pas accès au "compte de messagerie" il faut être administrateur.

voici le code du vbs:

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
170
171
172
173
174
175
176
177
178
179
180
181
 
 
' ----------------------------------------------------------
' Script VBS d'envoi de mail en ligne de commande
'
' Syntaxe : 
'  sendmail -e<expediteur> -d<destinataire> -o<objet> -m<message> [-s<signature>] [-p<piece-jointe>]
'  sendmail /e<expediteur> /d<destinataire> /o<objet> /m<message> [/s<signature>] [/p<piece-jointe>]
' Parames obligatoires :
'      <expediteur>   : adresse email de l'expteur
'      <destinataire> : adresse email du destinataire
'      <objet>        : objet (titre) du message
'      <message>      : corps du message
'                       Dans le cas d'un message sur plusieurs lignes,
'                       utiliser la sence "\n" pour chaque retour a ligne
' 						Si le message se rit n nom de fichier (existant),
'                       ce fichier sera lu et constituera le corps du message
' Parames facultatifs :
'      <signature>    : signature (peut-e un nom de fichier texte)
'      <piece-jointe> : nom de fichier quelconque en pi-jointe
' NB : les chaines et nom de fichier sont ncadrer par des guillemets
'      s'ils comportent des espaces
''
' JC BELLAMY  2002
' ----------------------------------------------------------
Dim args, fso, f,shell
Set fso   = WScript.CreateObject("Scripting.FileSystemObject")
Set shell = WScript.CreateObject("WScript.Shell")
Set args  = Wscript.Arguments
ForReading=1
 
nbargs=args.count
defmoteur="cscript"
If nbargs=0 or testarg("?") or testarg("h") Then Syntaxe ""
' Test du moteur utilisestHost
 
If not testarg("e") then Syntaxe "Email expteur absent"
If not testarg("d") then Syntaxe "Email destinataire absent"
If not testarg("o") then Syntaxe "Objet absent"
If not testarg("m") then Syntaxe "Message absent"
 
Exped=getarg("e")
If not IsValidEmail(Exped) Then  Syntaxe "Email expteur invalide"
Dest=getarg("d")
If not IsValidEmail(Dest) Then  Syntaxe "Email destinataire invalide"
Objet=getarg("o")
Mess=getarg("m")
body=GetString(Mess)
If testarg("s") Then
	Sign=getarg("s")
	body=body & VBCRLF & GetString(Sign)
	End If
Set objEmail = CreateObject("CDO.Message")
objEmail.From = Exped
objEmail.To = Dest
objEmail.Subject = Objet
objEmail.Textbody = body
If testarg("p") Then
	pj=getarg("p")
	If fso.FileExists(pj) Then objEmail.AddAttachment pj
	end if		
objEmail.Send
Wscript.quit
'--------------------------------------------------------------------
' Sous programme de test du moteur
Sub TestHost
dim rep
strFullName =lcase(WScript.FullName)
strappli=lcase(Wscript.ScriptFullName)
i=InStr(1,strFullName,".exe",1)
j=InStrRev(strFullName,"\",i,1)
strCommand=Mid(strFullName,j+1,i-j-1)
if strCommand<>defmoteur then
	rep=MsgBox( _
	"Pour faciliter l'affichage, il est recommand& VBCRLF & _
	"de lancer ce script avec """ & defmoteur & """" & VBCRLF & _ 
	"Cela peut e rendu permanent avec la commande" & VBCRLF & _
	"cscript //H:" & defmoteur &" //S /Nologo" & VBCRLF & _
	"Voulez-vous que ce soit fait automatiquement?", _
	vbYesNo + vbQuestion,strappli)
	if rep=vbYes  then 
		nomcmd="setscript.bat"
		Set ficcmd = fso.CreateTextFile(nomcmd)
		ficcmd.writeline "@echo off"
		ficcmd.writeline "cscript //H:" & defmoteur & " //S /Nologo"
		ficcmd.writeline "pause"
		params=""
		For i = 0 To nbargs-1 
			params=params & " " & args(i)
			next
		ficcmd.writeline chr(34) & strappli & chr(34) & params
		ficcmd.writeline "pause"
		ficcmd.close
		shell.Run nomcmd, SW_SHOWNORMAL,true
	    WScript.Quit
		end if
	end if
end sub
'--------------------------------------------------------------------
Sub Syntaxe(info)
If info="" Then
	msg=      "Script d'envoi de message (texte) en ligne de commande" & VBCRLF
	msg=msg & "JC BELLAMY  2002" & VBCRLF 
Else
	msg="*** " & info & " ***" & VBCRLF
	End If
msg=msg & "------------------------------------------" & VBCRLF
msg=msg & "Syntaxe : " & VBCRLF
msg=msg & " sendmail -e<expediteur> -d<destinataire> -o<objet> -m<message>" & VBCRLF
msg=msg & "          [-s<signature>] [-p<piece-jointe>]" & VBCRLF
msg=msg & " sendmail /e<expediteur> /d<destinataire> /o<objet> /m<message>" & VBCRLF
msg=msg & "          [/s<signature>] [/p<piece-jointe>]" & VBCRLF
msg=msg & "Parames obligatoires :" & VBCRLF 
msg=msg & "     <expediteur>   : adresse email de l'expteur" & VBCRLF
msg=msg & "     <destinataire> : adresse email du destinataire" & VBCRLF
msg=msg & "     <objet>        : objet (titre) du message" & VBCRLF
msg=msg & "     <message>      : corps du message" & VBCRLF
msg=msg & "                      Dans le cas d'un message sur plusieurs lignes," & VBCRLF
msg=msg & "                      utiliser la sence ""\n"" pour chaque retour a ligne" & VBCRLF
msg=msg & "                      Si le message se rit n nom de fichier (existant)," & VBCRLF
msg=msg & "                      ce fichier sera lu et constituera le corps du message"  & VBCRLF
msg=msg & "Parames facultatifs :"  & VBCRLF
msg=msg & "     <signature>    : signature (peut-e un nom de fichier texte)" & VBCRLF
msg=msg & "     <piece-jointe> : nom de fichier quelconque en pi-jointe" & VBCRLF
msg=msg & "NB : les chaines et noms de fichier sont ncadrer par des guillemets" & VBCRLF
msg=msg & "     s'ils comportent des espaces" & VBCRLF & VBCRLF
msg=msg & "Exemples :"& VBCRLF
msg=msg & " sendmail -eJean-Claude.Bellamy@wanadoo.fr -dbillg@microsoft.com -o""About VBS""" & VBCRLF
msg=msg & "    -m""VBSCript is a\nvery exciting tool!"" -sJCB -pm:\bitmaps\img.gif" & VBCRLF
msg=msg & " sendmail -ejc.bellamy@free.fr -dbillg@microsoft.com -o""More about VBS...""" & VBCRLF 
msg=msg & "    -m""d:\mes documents\txt\buglist.txt"" -sm:\texte\signature.txt" & VBCRLF & VBCRLF
wscript.echo msg
wscript.quit
End Sub
'--------------------------------------------------------------------
Function IsValidEmail(str)
Dim re
Set re = New RegExp
re.pattern = "\w+\@[.\w]+"  'Mod du style "nnnnnn@dddddd"
IsValidEmail=re.Test(str)
End Function
'--------------------------------------------------------------------
Function testarg(param)
testarg=false
For i = 0 To nbargs-1
	curarg=lcase(args(i))
	If left(curarg,1)="/" or left(curarg,1)="-" Then
		If mid(curarg,2,len(param))=param Then
			testarg=true
			exit function
			End If
		End If
	Next
End Function
'--------------------------------------------------------------------
Function getarg(param)
getarg=""
For i = 0 To nbargs-1
	curarg=lcase(args(i))
	If left(curarg,1)="/" or left(curarg,1)="-" Then
		If mid(curarg,2,len(param))=param Then
			ch=mid(args(i),2+len(param))
			If (left(ch,1)="""") and (right(ch,1)="""") Then ch=mid(ch,2,len(ch)-2)
			getarg= ch
			exit function
			End If
		End If
	Next
End Function
'--------------------------------------------------------------------
Function GetString(str)
dim f
If fso.FileExists(str) Then
	set f=fso.OpenTextFile(str,ForReading)
	GetString=f.ReadAll
	f.Close
else
	GetString=Replace(str,"\n",VBCRLF,1,-1,1)
	End If
End Function
'--------------------------------------------------------------------

et le vba qui marche sur mon PC et pas sur d'autres:

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 envoyer()
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim Temp As String
Dim CdoMessage As Object
Dim Fichier As String
Dim j As Integer
 
    Set Sourcewb = ActiveWorkbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 
    Temp = ThisWorkbook.Path & Application.PathSeparator & "Fichier.xls"
 
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
 
    Destwb.SaveAs Temp
    Fichier = Destwb.Path & Application.PathSeparator & Destwb.Name
    Destwb.Close
    Application.DisplayAlerts = True
 
    j = 1
    While Sheets("Destinataires").Cells(j, 1) <> ""
 
        Set CdoMessage = CreateObject("CDO.Message")
 
        With CdoMessage
            .Subject = Sheets("Message").Cells(1, 2)
            .From = Sheets("Message").Cells(3, 2)
            .To = Sheets("Destinataires").Cells(j, 1)
            .CC = ""
            .BCC = ""
            .TextBody = Sheets("Message").Cells(2, 2) & Chr(10) & "Le fichier d'origine est dans" & ThisWorkbook.Path
            .AddAttachment Fichier
            .Send
        End With
        j = j + 1
        Set CdoMessage = Nothing
'        Application.ScreenUpdating = True
 
    Wend
 
    Kill Fichier
End Sub

Et donc Oliv-, je ne mets pas de
cdoSendUsingMethod =cdoSendUsingPickup '= 1

j'ai pas vu ce code sur le forum, plutot ça:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
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.nomserveur.fr"
    .Update
End With

et comme ça fait appel à une page web et que le PC fixe n'a pas accès, j'ai pas approfondi. Y a une autre méthode?

[Oliv-]

Salut,
sur ton pc au bureau lance cela

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
Function GetSMTPServerConfig() As Object
' Microsoft CDO for Windows 2000 Library
    Const cdoSendUsingPickup = 1
    Const cdoSendUsingPort = 2
    Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
    Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
    Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
 
    Dim Cdo_Config As Object    'New CDO.Configuration
    Set Cdo_Config = CreateObject("CDO.Configuration")
    Dim Cdo_Fields As Object
    Set Cdo_Fields = Cdo_Config.Fields
 
    With Cdo_Fields
        .item(cdoSendUsingMethod) = cdoSendUsingPickup
 
        .Update
    End With
MsgBox Cdo_Fields.item(cdoSMTPServer) & vbCr & Cdo_Fields.item(cdoSMTPServerPort)
    Set GetSMTPServerConfig = Cdo_Config
    Set Cdo_Config = Nothing
    Set Cdo_Fields = Nothing
 
End Function

et recopie le serveur et le port dans le vbs ou ton vba

[Nelson77]

Bonjour,

j'ai récupéré le serveur + port, merci oliv- !

j'ai essayé ce code sur mon pc

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
 
Sub envoyer()
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim Temp As String
Dim CdoMessage As Object
Dim Fichier As String
Dim j As Integer
 
    'Set Sourcewb = ActiveWorkbook
    'ActiveSheet.Copy
    'Set Destwb = ActiveWorkbook
 
    'Temp = ThisWorkbook.Path & Application.PathSeparator & "Top_Secret.xls"
 
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
 
   ' Destwb.SaveAs Temp
   ' Fichier = Destwb.Path & Application.PathSeparator & Destwb.Name
    'Destwb.Close
    Application.DisplayAlerts = True
 
    j = 1
    While Sheets("Destinataires").Cells(j, 1) <> ""
 
        Set CdoMessage = CreateObject("CDO.Message")
 
        With CdoMessage
           With .Configuration.Fields ' Configuration "du compte mail SMTP"
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "monsmtp"
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "25"
            End With
 
 
            .Subject = Sheets("Message").Cells(1, 2)
            .From = Sheets("Message").Cells(3, 2)
            .To = Sheets("Destinataires").Cells(j, 1)
            .CC = ""
            .BCC = ""
            .TextBody = Sheets("Message").Cells(2, 2) & Chr(10) & "Le fichier d'origine est dans" & ThisWorkbook.Path
            '.AddAttachment Fichier
            .Send
        End With
        j = j + 1
        Set CdoMessage = Nothing
'        Application.ScreenUpdating = True
 
    Wend
 
    'Kill Fichier
End Sub

j'ai enlevé la partie pièce jointe pour tester rapido. Ca marche sur mon Pc, je vais tester sur le PC fixe dans la matinée.

croisons les doigts!

Patatra, ça marche toujours pas

j'ai le message:
"la valeur de configuration "SendUsing" est non valide"

avec l'erreur au .send

Si je lance la fonction GetSmtpServeurConfig, j'ai une fenêtre vide qui s'ouvre au lieu du serveur et du port comme sur mon PC

Si je fais tourner sur un autre PC (qui a accès à internet) même résultat...

Je vais revoir les paramètres des 2 PCs pour expliquer cette différence.

[Oliv-]

Salut,
Sur ton pc fixe c'est normal que le GetSmtpServeurConfig ne te renvois rien !
envoi moi en MP la valeur de smtpserver pour voir!

Essaye une connection telnet avec une invite de commande :

Code :

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

1
2
3
telnet 
open monserveur.smtp.fr 25   ' dois te renvoyer "...ready..."
ehlo monnom ' dois te renvoyer des lignes genre "...please to meet you"..

tu peux consulter ce site pour les syntaxes