Autres Ouverture Outlook en VBA

FOUQUET Yves

XLDnaute Occasionnel
Bonjour,

Quelqu'un peut me dire pourquoi dans la procédure ci dessous j'ouvre la boite d'envoi d'Outlook seulement et pas Outlook en entier ?

Merci de votre aide.
Yves

VB:
Sub ControleSiOutlookOuvert()   '---- ouverture de OUTLOOK
    Dim Appli As Object
    Dim SessionOutlook, myOlApp
    Const Chemin As String = "C:\Program Files\Microsoft Office\office11\OUTLOOK.exe"   '---> tu adaptes ce chemin si c'est nécessaire
 
    On Error Resume Next
    Set Appli = GetObject(, "Outlook.Application")
 
    'Tester si l'application est ouverte ou non
    If Appli Is Nothing Then
            MsgBox "Outlook est fermé"   '---> Donc ouvre moi une session
            SessionOutlook = Shell(Chemin, 1)
    End If
End Sub
'=======================================================

Private Sub CommandButton2_Click()   ' ceci correspond au bouton "Envoyer le message" qui ouvre et compléte Outlook

NomFichierComplet = UserForm1.chemin2 & "\Bonjour XXXX.jpg"
EmbedPicture NomFichierComplet    '"D:\Gestion AHI\Bonjour XXXX.jpg"
End Sub
'==============================================

Sub EmbedPicture(PathName As String)
  Dim MyPicture As String
  Dim img1 As String
  Dim Body As Variant
 
  TextBox11 = " Anniversaire en cours d'envoi via OUTLOOK"
  Repaint
  img1 = ""
  Workbooks("donnees.xlsm").Activate
  Worksheets("f_anniv").Select
  Set Ws = Sheets("f_anniv")
  ligne = Me.ComboBox1.ListIndex + 1  'se positionne sur l'index (ligne) du nom combobox
' CHEMIN ======
  img1 = NomFichierComplet    '"D:\Gestion AHI V2\BONJOUR XXXX.jpg"
  MyPicture = ""
  MyPicture = Mid(PathName, InStrRev(PathName, Application.PathSeparator) + 1)
  
   With CreateObject("Outlook.Application").CreateItem(0)
    .HTMLBody = ""
    .BodyFormat = olFormatHTML
    .HTMLBody = "<html><p>" & Body & "</p></html>"
    .Body = "Cher(e) ami(e) bonjour." & vbCr & "En cette journée particulière, ci joint un petit mot de notre président Christian DELAGRANGE." & vbCr & "Nous te souhaitons un joyeux anniversaire." & vbCr & "Merci pour votre aide toujours précieuse." & vbCr & "Bonne journée." & vbCr & "Le secrétariat d'AHI."
    .HTMLBody = .HTMLBody & "<td valign='middle'><b><img src='" & img1 & "'>" '-- dans le corps du message ---
    '.Attachments.Add img1  '--- si on veut mettre l'image en piéce jointe ----
    .To = Range("C" & ligne).Value
    .Subject = " Bon anniversaire"
    .Display
    '.Send    '--- envoi direct

    End With
TextBox11 = " "
Repaint
End Sub
 

G.David

XLDnaute Impliqué
parce qu'apparemment tu crées un message.
pour ouvrir seule la première procédure suffit un test fait chez moi avec thunderbird ( eh oui je n'ai pas outlook)
VB:
Sub ControleSiOutlookOuvert()   '---- ouverture de OUTLOOK
    Dim Appli As Object
    Dim SessionOutlook, myOlApp
    Const Chemin As String = "E:\instalation thunderbird\thunderbird.exe"   '---> tu adaptes ce chemin si c'est nécessaire
 
    On Error Resume Next
    Set Appli = GetObject(, "Outlook.Application")
 
    'Tester si l'application est ouverte ou non
    If Appli Is Nothing Then
            MsgBox "Outlook est fermé"   '---> Donc ouvre moi une session
            SessionOutlook = Shell(Chemin, 1)
    End If
End Sub
 

FOUQUET Yves

XLDnaute Occasionnel
1588789709373.png


Quand j'intégre la procédure "ouverture outlook, Voilà l'erreur que je retrouve sur la ligne: Set Appli = GetObject(, "Outlook.Application")
Grrrrrrrrrrr!



VB:
Sub EmbedPicture(PathName As String)
  Dim MyPicture As String
  Dim img1 As String
  Dim Body As Variant
 
  Dim Appli As Object
    Dim SessionOutlook, myOlApp
    Const Chemin As String = "C:\Programme (x86)\Microsoft Office\Office2012\OUTLOOK.exe"   '---> tu adaptes ce chemin si c'est nécessaire
 
    On Error Resume Next
    Set Appli = GetObject(, "Outlook.Application")
 
    'Tester si l'application est ouverte ou non
    If Appli Is Nothing Then
            MsgBox "Outlook est fermé"   '---> Donc ouvre moi une session
            SessionOutlook = Shell(Chemin, 1)
    End If
 
 
  TextBox11 = " Anniversaire en cours d'envoi via OUTLOOK"
  Repaint
  img1 = ""
  Workbooks("donnees.xlsm").Activate
  Worksheets("f_anniv").Select
  Set Ws = Sheets("f_anniv")
  ligne = Me.ComboBox1.ListIndex + 1  'se positionne sur l'index (ligne) du nom combobox
' CHEMIN ======
  img1 = NomFichierComplet    '"D:\Gestion AHI V2\BONJOUR XXXX.jpg"
  MyPicture = ""
  MyPicture = Mid(PathName, InStrRev(PathName, Application.PathSeparator) + 1)
  
   With CreateObject("Outlook.Application").CreateItem(0)
    .HTMLBody = ""
    .BodyFormat = olFormatHTML
    .HTMLBody = "<html><p>" & Body & "</p></html>"
    .Body = "Cher(e) ami(e) bonjour." & vbCr & "En cette journée particulière, ci joint un petit mot de notre président Christian DELAGRANGE." & vbCr & "Nous te souhaitons un joyeux anniversaire." & vbCr & "Merci pour votre aide toujours précieuse." & vbCr & "Bonne journée." & vbCr & "Le secrétariat d'AHI."
    .HTMLBody = .HTMLBody & "<td valign='middle'><b><img src='" & img1 & "'>" '-- dans le corps du message ---
    '.Attachments.Add img1  '--- si on veut mettre l'image en piéce jointe ----
    .To = Range("C" & ligne).Value
    .Subject = " Bon anniversaire"
    .Display
    '.Send    '--- envoi direct

    End With
TextBox11 = " "
Repaint
End Sub
 

FOUQUET Yves

XLDnaute Occasionnel
Bonsoir,
Voilà l'ensemble des procédures qui fonctionne correctement.
Cela peut aider quelqu'un.
Bonne soirée.

VB:
'============= debut procedure 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 Outlook
Dim PathName As String
If OutlookOuvert = False Then i = Shell("Outlook", vbNormalNoFocus)
' CHEMIN ======
NomFichierComplet = UserForm1.chemin2 & "\Bonjour XXXX.jpg"
EmbedPicture NomFichierComplet    '"D:\Gestion AHI V2\Bonjour XXXX.jpg"
End Sub

'==============================================
Sub EmbedPicture(PathName As String)
  Dim MyPicture As String
  Dim img1 As String
  Dim Body As Variant

  TextBox11 = " Anniversaire en cours d'envoi via OUTLOOK"
  Repaint

  Workbooks("donnees.xlsm").Activate
  Worksheets("f_anniv").Select
  Set Ws = Sheets("f_anniv")

  ligne = Me.ComboBox1.ListIndex + 1  'se positionne sur l'index (ligne) du nom combobox
' CHEMIN ======
  img1 = NomFichierComplet    '"D:\Gestion AHI V2\BONJOUR XXXX.jpg"

  MyPicture = Mid(PathName, InStrRev(PathName, Application.PathSeparator) + 1)
  With CreateObject("Outlook.Application").CreateItem(0)

    .HTMLBody = ""
    .BodyFormat = olFormatHTML
    .HTMLBody = "<html><p>" & Body & "</p></html>"
    .Body = "Cher(e) ami(e) bonjour." & vbCr & "En cette journée particulière, ci joint un petit mot de notre président Joseph DUPONT." & vbCr & "Nous te souhaitons un joyeux anniversaire." & vbCr & "Merci pour ton aide toujours précieuse." & vbCr & "Bonne journée." & vbCr & "Le secrétariat de l'association."
    .HTMLBody = .HTMLBody & "<td valign='middle'><b><img src='" & img1 & "'>" '-- dans le corps du message ---
    '.Attachments.Add img1  '--- si on veut mettre l'image en piéce jointe ----
    .To = Range("C" & ligne).Value
    .Subject = " Bon anniversaire"
    .Display
    .Send    '--- envoi direct

    End With
TextBox11 = " "
Repaint
End Sub
' ==== fin de procédure envoi du message =====
 

Discussions similaires

Réponses
2
Affichages
98

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla