Ajouter une signature outlook
r
Bonjour,
j'aimerais bien ajouter une signature d'une maniére automatique dans mon courriel , mais ça marche vraiment pas .
voici mon code
Sub Create_Mail_From_List_riadh()
Dim OApp As Object
Dim OMail As Object
Dim cell As Range
Dim bodymessage(0 To 9) As String
Dim fr(1 To 10) As String
Dim i As Integer
Dim Exp As Byte
Dim j As Integer
Dim signature As String
strPassword = "HR"
For lTries = 1 To 3
strPassTry = InputBox("Enter Password please", "PROTECTED")
If strPassTry = vbNullString Then
Exit Sub
End If
bSuccess = strPassword = strPassTry
If bSuccess Then Exit For
MsgBox "Password incorrect"
Next lTries
If Not bSuccess Then
MsgBox "Wrong password privided!"
Exit Sub
End If
Application.ScreenUpdating = False
Set OApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For i = 3 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
bodymessage(0) = ""
bodymessage(1) = ""
bodymessage(2) = ""
bodymessage(3) = ""
bodymessage(4) = ""
bodymessage(5) = ""
bodymessage(6) = ""
bodymessage(7) = ""
bodymessage(8) = ""
bodymessage(9) = ""
fr(1) = ""
fr(2) = ""
fr(3) = ""
fr(4) = ""
fr(5) = ""
fr(6) = ""
fr(7) = ""
fr(8) = ""
fr(9) = ""
fr(10) = ""
fr9 = ""
fr10 = ""
'ActiveSheet.Cells(1, 12) = ActiveSheet.Cells(1, 12) & "(" & cell.Row & "," & cell.Column & "), "
If Sheets("Exams-email results").Cells(i, 3).Text Like "?*@?*.?*" And _
LCase(Cells(i, "O").Value) = "dnm" Then
Set OMail = OApp.CreateItem(0)
On Error Resume Next
signature = OMail.Body
With OMail
.CC = Sheets("Screening-email results").Range("W16")
.BCCSheets("Screening-email results").Range ("W17")
.SentOnBehalfOfName = Sheets("Exams-email results").Range("W15")
.To = ActiveSheet.Cells(i, 3).Text
.Subject = Sheets("Exams-email results").Range("W3") & " / " & Sheets("Exams-email results").Range("W6")
'& "Groupe " & ActiveSheet.Cells(i, 10).Text & " / Niveau " & ActiveSheet.Cells(i, 11).Text'
For Exp = 1 To 10
Select Case Exp
Case 1 To 10
'Abilities/ capacities'
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "A1" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B26").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C26").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "A2" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B27").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C27").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "A3" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B28").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C28").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "A4" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B29").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C29").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "A5" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B30").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C30").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "A6" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B31").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C31").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "A7" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B32").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C32").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "A8" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B33").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C33").Text
End If
'Personal suitability'
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "PS1" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B35").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C35").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "PS2" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B36").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C36").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "PS3" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B37").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C37").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "PS4" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B38").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C38").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "PS5" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B39").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C39").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "PS6" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B40").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C40").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "PS7" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B41").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C41").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "PS8" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B42").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C42").Text
End If
'Knowledges'
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "K1" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B20").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C21").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "K2" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B21").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C21").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "K3" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B22").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C22").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "K4" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B23").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C23").Text
End If
If LCase(Cells(i, 3 + Exp).Text) = "dnm" And Sheets("Exams-email results").Cells(3, 3 + Exp) = "K5" Then
bodymessage(Exp - 1) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("B24").Text
fr(Exp) = vbNewLine & " ** " & Sheets("SOMC-Legend").Range("C24").Text
End If
End Select
Next Exp
corps6 = _
vbNewLine & vbNewLine & " Appointment Process Number: " & Sheets("Exams-email results").Range("W3") _
& vbNewLine & " Branch : " & Sheets("Exams-email results").Range("W4") _
& vbNewLine & " Position Title : " & Sheets("Exams-email results").Range("W5") _
& vbNewLine & " Group and Level: " & Sheets("Exams-email results").Range("W6") _
& vbNewLine & " Language Requirements : " & Sheets("Exams-email results").Range("W7") _
& vbNewLine & vbNewLine _
& vbNewLine & "Good Day , " _
& vbNewLine & vbNewLine & "Further to the written exam in which you took part for the above-mentioned appointment process,the assessment board has determined that you do not possess the following essential qualification(s) assessed: "
corps7 = vbNewLine & vbNewLine & "If you would like to informally discuss this decision, please send an e-mail to : " & Sheets("Exams-email results").Range("W13") & " .Please submit your request as soon as possible to allow sufficient time for corrective measures to be taken, if required." _
& vbNewLine & "Please note that notifications of persons being considered and being appointed will be posted on jobs.gc.ca site"
corps8 = ". Employees are responsible for checking jobs.gc.ca site on a regular basis. If you have not already done so, I recommend you register with e-mail alerts service which allows users to automatically receive e-mail updates on new Notifications and Advertisements which may be of interest to them. More information on e-mail alerts service, including registration information, is available on jobs.gc.ca site."
corps9 = vbNewLine & "Should you require additional information, please send an e-mail to: " & Sheets("Exams-email results").Range("W14") _
& vbNewLine & vbNewLine & "Thank you for your interest in this process and may I take this opportunity to wish you success in your future endeavors." _
& vbNewLine & vbNewLine & vbNewLine & "**This e-mail message is intended for the named recipient(s) and may contain information that is privileged, confidential and/or exempt from disclosure under applicable law. Unauthorized disclosure, copying or re-transmission is prohibited. If you are not a named recipient or not authorized by the named recipient(s), or if you have received this e-mail in error, then please notify the sender immediately and delete the message and any copies.**"
corps10 = vbNewLine & " ************************************" _
& vbNewLine & _
vbNewLine & vbNewLine & " Numéro du processus de nomination " & Sheets("Exams-email results").Range("W3") _
& vbNewLine & " Direction Générale : " & Sheets("Exams-email results").Range("W10") _
& vbNewLine & " Titre du poste : " & Sheets("Exams-email results").Range("W11") _
& vbNewLine & " Groupe et niveau : " & Sheets("Exams-email results").Range("W6") _
& vbNewLine & " Exigences linguistiques : " & Sheets("Exams-email results").Range("W7") _
& vbNewLine & vbNewLine _
& vbNewLine & "Bonjour , " _
& vbNewLine & vbNewLine & "À la suite de l'examen écrit auquel vous avez participé dans le cadre du processus susmentionné, le comité d'évaluation a détérminé que vous ne possédez pas la(les) qualification(s) essentielle(s) évaluée(s) suivante(s):"
corps11 = vbNewLine & vbNewLine & "Si vous souhaitez discuter de manière informelle de cette décision, veuillez envoyer un courriel à : " & Sheets("Exams-email results").Range("W13") & " .Veuillez soumettre votre demande le plus rapidement possible afin de prévoir suffisamment de temps pour que des mesures correctives puissent être prises, s'il y a lieu." _
& vbNewLine & "Veuillez noter que les notifications des personnes dont la candidature est retenue et de celles qui sont nommées seront affichées sur le site emplois.gc.ca. " _
& vbNewLine & "Il incombe aux employés de consulter périodiquement le site emplois.gc.ca. Si vous ne l'avez déjà fait, je vous conseille de vous inscrire au service d'alertes par courriel qui permet aux usagers de recevoir automatiquement, par courrier électronique, des mises à jour sur les nouvelles notifications et annonces de possibilité d'emploi qui peuvent les intéresser. Pour en savoir davantage sur le service d'alertes par courriel et sur la façon de vous y inscrire, veuillez consulter le site emplois.gc.ca." _
& vbNewLine & "Si vous avez besoin de renseignements supplémentaires, veuillez envoyer un courriel à : " & Sheets("Exams-email results").Range("W13") _
& vbNewLine & "Je vous remercie de votre intérêt pour ce processus et saisis cette occasion pour vous souhaiter un franc succès dans vos projets futurs" _
& vbNewLine & vbNewLine & vbNewLine & "**Ce message courriel s'adresse aux destinataires nommés et peut renfermer des renseignements privilégiés, confidentiels et/ou soustraits à la communication en vertu de la loi applicable. La divulgation non autorisée, la copie ou la retransmission de ce message est interdite. Si vous n'êtes pas un destinataire nommé et si vous n'êtes pas autorisé par le(s) destinataire(s) nommé(s), ou si vous avez reçu ce courriel par erreur, veuillez en aviser l'expéditeur immédiatement et supprimer le message ainsi que toute copie de celui-ci.**"
corps13 = vbNewLine & "Si vous avez besoin de renseignements supplémentaires, veuillez envoyer un courriel à : " & Sheets("Exams-email results").Range("W14") & "" _
& " Je vous remercie de votre intérêt pour ce processus et saisis cette occasion pour vous souhaiter un franc succès dans vos projets futurs." _
& vbNewLine & "Ce message courriel s'adresse aux destinataires nommés et peut renfermer des renseignements privilégiés," _
& " confidentiels et/ou soustraits à la communication en vertu de la loi applicable. La divulgation non autorisée," _
& " la copie ou la retransmission de ce message est interdite. Si vous n'êtes pas un destinataire nommé et si vous n'êtes pas autorisé par le(s) destinataire(s) nommé(s), ou si vous avez reçu ce courriel par erreur," _
& " veuillez en aviser l'expéditeur immédiatement et supprimer le message ainsi que toute copie de celui-ci.**"
.Body = corps6 & bodymessage(0) & bodymessage(1) & bodymessage(2) & bodymessage(3) & bodymessage(4) & bodymessage(5) & bodymessage(6) & bodymessage(7) & bodymessage(8) & bodymessage(9) & ex8 & ex9 & corps7 & corps8 & corps9 & corps10 & fr(1) & fr(2) & fr(3) & fr(4) & fr(5) & fr(6) & fr(7) & fr(8) & fr(9) & fr(10) & fr9 & fr10 & corps11 & signature
'"Dear " & Cells(i, "A").Value'
'.Body = "Dear " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
" " & _
" "
'End If
' If LCase(Cells(cell.Row, "F").Value) = "dnm" Then
'.Body = Sheets("lien").Range("B10").Value
'End If
'.Attachments.Add "C:\Users\riadh.said@cic.gc.ca\Desktop\" & ActiveSheet.Cells(i, 1).Value & ", " & ActiveSheet.Cells(i, 2).Value & ".pdf", 17
.Display 'Or use Display
For j = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
If LCase(ActiveSheet.Cells(i, 15).Text) = "dnm" Then
ActiveSheet.Cells(i, 16).Value = "Sent"
End If
Next j
End With
On Error GoTo 0
Set OMail = Nothing
Set OApp = Nothing
End If
Next i
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub