'============= début procédure ouverture Outlook =======================
Function OutlookOuvert() As Boolean
Dim oOL As Object
On Error Resume Next
Set oOL = GetObject(, "Outlook.Application")
On Error GoTo 0
OutlookOuvert = Not (oOL Is Nothing)
Set oOL = Nothing
End Function
'--------------------------
Private Sub CommandButton2_Click() ' ceci correspond au bouton "Envoyer le message" qui ouvre et compléte Outlookexpress
'================================================
Dim PathName As String
Dim i As Integer
If OutlookOuvert = False Then i = Shell("Outlook", vbNormalNoFocus)
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "D:\Gestion AHI\Bonjour XXXX.jpg" ' Chemin du fichier
If .Filters.Count > 0 Then .Filters.Delete
.Filters.Add "Images", "*.gif; *.png; *.jpg; *.jpeg", 1
.AllowMultiSelect = False
'If .Show = False Then Exit Sub
'PathName = .SelectedItems(1)
'EmbedPicture "D:\Gestion AHI\Bonjour XXXX.jpg"
End With
Call EmbedPicture("D:\Gestion AHI\Bonjour XXXX.jpg")
End Sub
Sub EmbedPicture(PathName As String)
Dim MyPicture As String
Dim ligne As Integer
ligne = Me.ComboBox1.ListIndex + 1
'se positionne sur l'index (ligne) du nom combobox
'récuperer les infos dans combobox
MyPicture = Mid(PathName, InStrRev(PathName, Application.PathSeparator) + 1)
With CreateObject("Outlook.Application").CreateItem(0)
.Attachments.Add "D:\Gestion AHI\Bonjour XXXX.jpg"
.HTMLBody = "<html><p>Cher(e) ami(e) bonjour,</p> En ce jour particulier, un mot du président d'A.H.I</p>" & _
"<img src=cid:" & Replace(MyPicture, " ", "%20") & _
"<p>Bon anniversaire,</p>" & _
"<p>" & "</p></html>"
.To = Range("C" & ligne).Value
.Subject = " Anniversaire "
.Display
.Send
End With
Attendre 5 ' j'attends 5 secondes. Fonction définie plus haut
'Outlook.Quit là je ne sais pas que faire
'car outlook ferme trop tôt et le message n'est pas parti!!!!
'donc pour l'instant je zappe
End Sub
' ==== fin de procédure envoi du message =====