bonjour,

je cherche à attacher le contenu d'un répertoire en pièces jointes.
pièce par pièce en dur pas de problèmes.
Merci pour votre aide

voici mon script

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
cdo()
 
 
 
 
Sub cdo()
 
Dim oFSO,oFld
Set oFSO = CreateObject("Scripting.FileSystemObject")
stRep = "C:\partage\Images"
On Error Resume Next
 With CreateObject("CDO.Message" )
  If Err Then
   MsgBox "CDO non installé"
  Else
 .From="********@****"
 .To="*****@***"
 .Subject="*****"
 .TextBody="*****"
 .Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing" ) = 2
 .Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver" ) = "mailhost.der.edf.fr" 'par exemple
 .Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport" ) = 25
 '.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername" ) = "NOM D'UTILISATEUR DU COMPTE QUI ENVOIE LES MAIL"
 '.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword" ) = "MOT DE PASSE DU COMPTE QUI ENVOIE LES MAILS"  
	 For each oFl in  oFSO.GetFolder(stRep).Files
	.AddAttachment oFl.Name
	WScript.Echo oFl.Name
	 Next
 
	 .Configuration.Fields.Update
 .Send
 If Err Then MsgBox "Le message n'a pas pu être expédié."
End If
On Error GoTo 0
End With 
End sub