Autres Ouverture Outlook en VBA

  • Initiateur de la discussion Initiateur de la discussion FOUQUET Yves
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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
 
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
 
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
 
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 =====
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
358
  • Question Question
Microsoft 365 Code VBA
Réponses
7
Affichages
634
  • Question Question
Microsoft 365 Question code VBA
Réponses
2
Affichages
386
Retour