Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Autres Ouverture Outlook en VBA

F

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
 
Trier par date Trier par votes

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
 
Vote positif 0 Vote négatif
F

FOUQUET Yves

XLDnaute Occasionnel
Suis allé voir mais les lignes de codes à disposition, tout comme les tiennes, donnent le même résultat: Boite d'envoi s'ouvre correctement mais pas Outlook.
Donc il faut retourner ouvrir Outlook pour faire envoyer/recevoir.
 
Vote positif 0 Vote négatif
F

FOUQUET Yves

XLDnaute Occasionnel


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
 
Vote positif 0 Vote négatif
F

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 =====
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

G
  • Résolu(e)
XL 2021 Envoie d'informations sélectionnés par mail
Réponses
3
Affichages
202
TooFatBoy
N
  • Question
Microsoft 365 Envoi via Excel avec OutlookNew
Réponses
4
Affichages
393
Titou37P
R
  • Résolu(e)
Microsoft 365 Extraction contenu mail outlook vers excel
2
Réponses
18
Affichages
1 K
raf26
R
G
  • Question
Microsoft 365 Vba Excel l'instruction Set OutApp = CreateObject("Outlook.Application") bloque excel
Réponses
2
Affichages
247
laurent950
B
  • Question
XL 2016 VBA - Ajout de consignes dans le corps d'un mail
Réponses
3
Affichages
199
kiki29
F
  • Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
302
Oneida
N
  • Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
307
Phil69970
S
  • Résolu(e)
Microsoft 365 Envoi de la signature de l'utilisateur macro envoi de mail
Réponses
3
Affichages
205
spike29
S
N
  • Question
Microsoft 365 Code VBA
Réponses
7
Affichages
592
TooFatBoy
K
  • Résolu(e)
XL 2019 Probleme codage
Réponses
2
Affichages
375
Kevin42560
K
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…