Surtout ne pas oublier le Sleep c'est le temps nécessaire à Notes pour enregistrer le document dans le Mémo.
Autrement risque du gros message ROUGE[/quote]
- Code : Tout sélectionner
Option Public
Option Declare
Dim db As NotesDatabase
Dim collection As NotesDocumentCollection, coll_Offres As NotesDocumentCollection
Dim int_nbre_candidats As Integer, k As Integer
Dim doc As NotesDocument, doc_Offre As NotesDocument, doc_Resp As NotesDocument
Dim doc_Mail As NotesDocument, doc_Modele As NotesDocument, doc_Courrier As NotesDocument, doc_Param As NotesDocument
Dim vw_Modele As NotesView, vw_Courriers As NotesView, vw_Parametres As NotesView
Dim vw_Candidats As NotesView
Dim str_Qui As String, str_ID_Qui As String, str_Mail As String, str_CP As String, str_Ville As String, str_Mail_Param As String
Dim str_Civil As String, str_Adresse As String, str_CP_Ville As String, str_Champ As String, str_Nom As String, str_Prenom As String
Dim dateTime As NotesDateTime
Dim scheditem As NotesItem, Options_Item As NotesItem, Date_Item As NotesItem
Dim rtitem As NotesRichTextItem
Dim Excel_Page As NotesEmbeddedObject
Dim uidoc As NotesUIDocument
Dim str_Signataire_RH As String, str_Titre_RH As String, str_IDs As String
Dim var_IDs As Variant
Dim doc_Corps_Mail_1 As NotesDocument, doc_Corps_Mail_2 As NotesDocument, doc_Corps_Mail_3 As NotesDocument, doc_Corps_Mail_4 As NotesDocument, doc_Corps_Mail_5 As NotesDocument
Dim str_Mail_Corp_1 As String, str_Mail_Corp_2 As String, str_Mail_Corp_3 As String, str_Mail_Corp_4 As String, str_Mail_Corp_5 As String
Sub Initialize
Dim s As New NotesSession
Dim w As New NotesUIWorkspace
Set db = s.CurrentDatabase
Set vw_Modele = db.GetView("va_Modeles")
Set doc_Modele = vw_Modele.GetDocumentByKey("NEG_CONTRAT_QUAL",True)
Set vw_Courriers = db.GetView("va_CourriersParIDOffreCandidat")
Set vw_Candidats = db.GetView("va_CandidatsIDs")
Set uidoc = w.CurrentDocument
str_Signataire_RH = uidoc.FieldGetText("fld_Qui")
str_Titre_RH = uidoc.FieldGetText("fld_Fonction")
str_IDs = uidoc.FieldGetText("fld_IDs")
var_IDs = Evaluate("@Explode(""" + str_IDs + """;""; "")")
For k = 0 To Ubound(var_IDs)
Set doc = vw_Candidats.GetDocumentByKey(Cstr(var_IDs(k)), True)
If Not doc Is Nothing Then
str_Civil = doc.fld_Civilite(0)
str_Nom = doc.fld_Nom(0)
str_Prenom = doc.fld_Prenom(0)
str_Adresse = doc.fld_Adresse(0)
str_CP = doc.fld_CodePostal(0)
str_Ville = doc.fld_Ville(0)
str_CP_Ville = str_CP & " " & str_Ville
str_Qui = str_Civil & " " & str_Nom & " " & str_Prenom
If doc.fld_CandidatureProv01(0) = "9" Then
doc.fld_CandidatureRep01= "2"
doc.fld_CandidatureTrai01 = "1"
Elseif doc.fld_CandidatureProv02(0) = "9" Then
doc.fld_CandidatureRep02= "2"
doc.fld_CandidatureTrai02 = "1"
Elseif doc.fld_CandidatureProv03(0) = "9" Then
doc.fld_CandidatureRep03= "2"
doc.fld_CandidatureTrai03 = "1"
Elseif doc.fld_CandidatureProv04(0) = "9" Then
doc.fld_CandidatureRep04= "2"
doc.fld_CandidatureTrai04 = "1"
Elseif doc.fld_CandidatureProv05(0) = "9" Then
doc.fld_CandidatureRep05= "2"
doc.fld_CandidatureTrai05 = "1"
Else
Msgbox "Le candidat " & doc.fld_Nom(0) & " " & doc.fld_Prenom(0) & " n'a pas fait de demande de contrat de qualification"
Goto SUIVANT
End If
str_ID_Qui = doc.fld_ID_Candidat(0)
str_Mail = doc.fld_Mail(0)
If str_Mail = "" Then
Msgbox "Le candidat " & str_Qui & " n'a pas d'e-mail. Impression de la Réponse."
Call ImprimerResponse (doc, str_Qui, str_ID_Qui)
Else
Call CreateResponse (doc, str_Qui, str_ID_Qui)
Call GenererMailerWord (doc_Modele)
Msgbox "Un mail de réponse à été envoyé au candidat " & str_Qui & "."
End If
Call doc.Save(True,True)
End If
Next
SUIVANT:
Call uidoc.Close
End Sub
Sub GenererMailerWord(doc_Modele As NotesDocument)
Dim wordApp As Variant, wordDoc As Variant, wordDocs As Variant
Dim object As NotesEmbeddedObject
Set vw_Parametres = db.GetView("va_Tables")
Set doc_Param = vw_Parametres.GetDocumentByKey("MAIL", True)
str_Mail_Param = doc_Param.fld_Value(0)
Set doc_Corps_Mail_1 = vw_Parametres.GetDocumentByKey("CORP_MAIL_1", True)
str_Mail_Corp_1 = doc_Corps_Mail_1.fld_Value(0)
Set doc_Corps_Mail_2 = vw_Parametres.GetDocumentByKey("CORP_MAIL_2", True)
str_Mail_Corp_2 = doc_Corps_Mail_2.fld_Value(0)
Set doc_Corps_Mail_3 = vw_Parametres.GetDocumentByKey("CORP_MAIL_3", True)
str_Mail_Corp_3 = doc_Corps_Mail_3.fld_Value(0)
Set doc_Corps_Mail_4 = vw_Parametres.GetDocumentByKey("CORP_MAIL_4", True)
str_Mail_Corp_4 = doc_Corps_Mail_4.fld_Value(0)
Set doc_Corps_Mail_5 = vw_Parametres.GetDocumentByKey("CORP_MAIL_1_bis", True)
str_Mail_Corp_5 = doc_Corps_Mail_5.fld_Value(0)
Set wordApp = CreateObject( "Word.Application" )
wordApp.Visible = False
Set wordDocs = wordApp.Documents
Set Excel_Page = doc_Modele.GetAttachment( "Modele.dot" )
Call Excel_Page.ExtractFile("C:\Modele.dot")
Call wordDocs.Add( "C:\Modele.dot", False )
Set wordDoc = wordDocs(1)
wordDoc.Activate
wordDoc.Bookmarks( "ADRESSE" ).Range.text = str_Adresse
wordDoc.Bookmarks( "DATE" ).Range.text = Cstr(Date$)
wordDoc.Bookmarks( "CIV" ).Range.text = str_Civil
wordDoc.Bookmarks( "VILLE" ).Range.text = str_Ville
wordDoc.Bookmarks( "CP" ).Range.text = str_CP
wordDoc.Bookmarks( "NOM" ).Range.text = str_Nom
wordDoc.Bookmarks( "PRENOM" ).Range.text = str_Prenom
wordDoc.Bookmarks( "TITRE" ).Range.text = str_Civil
wordDoc.Bookmarks( "TITRE_END" ).Range.text = str_Civil
wordDoc.Bookmarks( "RRH" ).Range.text = str_Signataire_RH
wordDoc.Bookmarks( "TITRE_RH" ).Range.text = str_Titre_RH
wordDoc.SaveAs "C:\Rep.doc"
Call wordApp.Quit
Set WordApp = Nothing
Set doc_Mail = db.CreateDocument
doc_Mail.Form = "Memo"
doc_Mail.Subject = "Courrier candidature"
doc_Mail.ReturnReceipt = "1"
Set rtitem = New NotesRichTextItem( doc_Mail, "Body" )
Call rtitem.AppendText( str_Civil )
Call rtitem.AddNewLine(2)
Call rtitem.AppendText( str_Mail_Corp_1 )
Call rtitem.AddNewLine(2)
If str_Mail_Corp_5 <> "" Then
Call rtitem.AppendText( str_Mail_Corp_5 )
Call rtitem.AddNewLine(2)
End If
Call rtitem.AppendText( str_Mail_Corp_2 )
Call rtitem.AddNewLine(1)
Call rtitem.AppendText( str_Mail_Corp_3 )
Call rtitem.AddNewLine(1)
Call rtitem.AppendText( str_Mail_Corp_4 )
Call rtitem.AddNewLine(3)
Set object = rtitem.EmbedObject ( EMBED_ATTACHMENT, "", "C:\Rep.doc")
If str_Mail_Param = "0" Then
Call doc_Mail.Save(True, True)
Elseif str_Mail_Param = "1" Then
Call doc_Mail.Send( False, str_Mail )
End If
Sleep(3)
Kill "C:\Modele.dot"
Kill "C:\Rep.doc"
End Sub
Sub CreateResponse (doc As NotesDocument, str_Qui As String, str_ID_Qui As String)
Dim w As New NotesUIWorkspace
Set doc_Resp = db.CreateDocument
doc_Resp.Form = "fa_Courrier_NR_CONTRAT_QUAL"
doc_Resp.fld_Candidat = str_Civil
doc_Resp.fld_Candidat1 = str_Civil
doc_Resp.fld_ID_Candidat = str_ID_Qui
doc_Resp.fld_CIV = str_Qui
doc_Resp.fld_Adresse = str_Adresse
doc_Resp.fld_CP_Ville = str_CP_Ville
doc_Resp.fld_Titre_RH = str_Titre_RH
doc_Resp.fld_RRH = str_Signataire_RH
Set dateTime = New NotesDateTime(Date$)
Set scheditem = doc_Resp.ReplaceItemValue("fld_DateJour", dateTime)
Set date_item = doc_Resp.ReplaceItemValue("fld_Date", dateTime)
Call doc_Resp.Save( True, True )
End Sub
Sub ImprimerResponse (doc As NotesDocument, str_Qui As String, str_ID_Qui As String)
Dim w As New NotesUIWorkspace
Dim uidoc_Resp As NotesUIDocument
Set doc_Resp = db.CreateDocument
doc_Resp.Form = "fa_Courrier_NR_CONTRAT_QUAL"
doc_Resp.fld_Candidat = str_Civil
doc_Resp.fld_Candidat1 = str_Civil
doc_Resp.fld_ID_Candidat = str_ID_Qui
doc_Resp.fld_CIV = str_Qui
doc_Resp.fld_Adresse = str_Adresse
doc_Resp.fld_CP_Ville = str_CP_Ville
doc_Resp.fld_Titre_RH = str_Titre_RH
doc_Resp.fld_RRH = str_Signataire_RH
Set dateTime = New NotesDateTime(Date$)
Set scheditem = doc_Resp.ReplaceItemValue("fld_DateJour", dateTime)
Set date_item = doc_Resp.ReplaceItemValue("fld_Date", dateTime)
Call doc_Resp.Save( True, True )
Set uidoc_Resp = w.EditDocument( False, doc_Resp )
Call uidoc_Resp.Print
Call uidoc_Resp.Close
End Sub
