Je voudrais effectuer un mailing depuis une messagerie.
J'ai créé un agent qui laisse la possibilité de selectionner son fichier excel avec les coordonnées des destinataires et qui envoie les mail à chacun d'eux.
Le truc c'est que maintenant je voudrais avoir un fenetre qui s'ouvre pour selectionner le fichier que devra etre joint à chaque mail.
J'ai réussi à faire la fenetre de saisie donc la pas de soucis par contre je n'arrive pas à inserer automatiquement dans chaque mail la pièce jointe.
Quelqu'un aurait il une idée ?
Voici mon agent :
Sub Initialize
Const DEFAUTREP="c:\" 'le chemin par défaut à l'ouverture de la boite de dialogue
Const DEFAUTEXT="Fichiers Excel|*.xls|Tous|*.*" ' le type de fichier que la personne a le droit de séléctionner
Dim fichier As Variant
Dim view As NotesView
Dim create( 1 To 16) As String'on créer un tableau
Dim i As Integer
Dim ws As New NotesUIWorkspace
'---------------------------------------
Dim session As NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim XLApp As Variant
Dim XLWorkBook As Variant
Dim ActiveWorkBook As Variant
Dim Sheet As Variant
Dim Cellule As Variant
Dim colonne As Long
Dim ligne As Long
On Error GoTo Erreur
'// Initialisation de la session, base actuelle et vue
Set session=New NotesSession
Set db = session.CurrentDatabase
'//Obligation de créé une vue Mailing dans la base
Set view = db.GetView("Mailing")
'// Initialisation de l'objet OLE ou Instance OLE
'// Ouverture de l'application Excel sans ouverture de classeur
'// On fourni le fichier
fichier = ws.OpenFileDialog(False, "Liste des destinataires", DEFAUTEXT, DEFAUTREP)
If IsEmpty(fichier) Then Exit Sub '// cas si l'utilisateur abandonne la sélection du fichier
'// Récupère le fichier à joindre au mailing PieceJointe = ws.OpenFileDialog(False, "Fichier à joindre au mailing", "*.*", DEFAUTREP)
If IsEmpty(PieceJointe) Then Exit Sub '// cas si l'utilisateur abandonne la sélection du fichier
Set XLApp = CreateObject("Excel.Application")
XLApp.Visible = True
XLApp.DisplayAlerts = False
Set XLWorkBook=XLApp.workbooks
XLWorkBook.Open fichier
' Ou mettre en dure le chemin du fichier Excel "C:\\modèle\Classeur1.xls"
Set ActiveWorkBook=XLApp.ActiveWorkBook
Set Sheet=ActiveWorkBook.ActiveSheet
Set Cellule=Sheet.Cells
'initialisation des variables pour le traitement
Ligne=2 'je commence à la ligne 2 généralement ligne 1 réserve le nom des colonnes
Colonne=1
i=1
Do While Not IsEmpty(Cellule(Ligne,Colonne).Value)
For Colonne=1 To 2 '16
'Print Cellule(Ligne,Colonne).Value
Create(i)=Trim(Cellule(Ligne,Colonne).Value)
'on insère les valeurs dans un tableau
i=i+1
Next
Call createDocument(create(),db)'on appel la fonction pour créer le document
i=1 'on reinitialise i car on crée un autre tableau pour un autre document
Colonne = 1'on remet colonne a 1
Ligne=Ligne + 1 'on passe a la ligne suivante
Print"Nombre de Lignes lus :" & CStr(Ligne-2)
Loop
Call view.Refresh 'on rafraichit la vue
ActiveWorkBook.Close
XLApp.Quit
Set xlapp=Nothing 'Stop l'automation excel
Set db=Nothing
Exit Sub
Erreur:
XLApp.Quit
Set xlapp=Nothing 'Stop l'automation excel
Set db=Nothing
Exit Sub
End Sub
Avec dans CreateDocument :
- Code : Tout sélectionner
Function createDocument(FieldArray() As String, db As NotesDatabase) As Integer
On Error GoTo Erreur
'Fonction qui crée un document et insère les différents informations
'Dim session As New notessession
'Dim db As notesdatabase
'Set db = session.currentdatabase
Dim doc As New NotesDocument(db)
If FieldArray(1) <> "" Then 'And FieldArray(1)<309999
doc.Form = "Memo"
Call doc.ReplaceItemValue("SendTo",FieldArray(1))
Call doc.ReplaceItemValue("Subject","JURAFILTRATION - Nouveau produit")
doc.Mailing = "OUI"
Call ChampBody.AddNewLine( 2 )
Call ChampBody.AppendText( "texte a mettre dans le corps du mail " )
Call ChampBody.AddNewLine( 2 )
Call ChampBody.AppendText( "Pièce jointe : " )
Call ChampBody.AddNewLine( 1 )
Call ChampBody.AppendText( ................... ) 'ICI JE VOUDRAIS AVOIR LE FICHIER JOINT
Call ChampBody.AddNewLine( 1 )
Call doc.ReplaceItemValue("Body",ChampBody)
Call doc.Send( False )
Call doc.save(1,0)
End If
Erreur:
'Set db=Nothing
Exit Function
End Function
