attacher contenu repertoire dans un mail
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:
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 |
