VBA - Détecter si une application est installée pour l'utiliser

Question

J'ai fait un fichier Excel qui stocke beaucoup d'informations sur les pièces industrielles.
Il permet aux utilisateurs de envoyer via Outlook un mail préformaté pour demander un nouveau prix.

Malheureusement, certains utilisateurs ont bureau "light" sans Outlook et ils obtiennent une erreur:

Impossible de trouver le projet ou la bibliothèque

Installation Outlook est malheureusement pas une option, la fin de la séance d'attelage est déjà terminée.

---

Je pensais à directives de préprocesseur mais je ne peux pas comprendre comment les utiliser dans mon cas ...

Je connais les constantes que nous pouvons utiliser pour les versions Windows et VBA: see here

je l'aurais fait quelque chose comme ceci:

#If Outlook then 
    MsgBox "Outlook is installed" 
#Else 
    MsgBox "Outlook is NOT installed" 
#End if 

Mais cela ne détecte si le code est exécuté à partir d'Outlook ou non, ce qui est pas ce que je dois ...:/

---

Je suppose que je pouvais faire quelque chose avec ce On Error, mais il ne semble pas soignée, des suggestions?

Answer 1

J'ai essayé de trouver d'autres moyens d'applications détecter sans compter sur les erreurs de CreateObject

Il utilise l'objet WMI et il semble bien fonctionner mais il ne distingue pas une version de démonstration
Il répertorie les applications installées dans chemin de registre Microsoft\Windows\CurrentVersion\App Paths (32 & 64 bits)

---

Public Function AppDetected() As Boolean 
    Const HKEY_LOCAL_MACHINE = &H80000002 'HKEY_CURRENT_USER = &H80000001 
    Const APP_PATH = "\Microsoft\Windows\CurrentVersion\App Paths\" 
    Const APP_PATH_32 = "SOFTWARE" & APP_PATH 
    Const APP_PATH_64 = "SOFTWARE\Wow6432Node" & APP_PATH 
    Const REG_ITM = "!\\.\root\default:StdRegProv" 
    Const REG = "winmgmts:{impersonationLevel=impersonate}" & REG_ITM 
    Const ID = "Outlook" '"OUTLOOK.EXE" 

    Dim wmi As Object, subKeys As Variant, found As Variant 

    If wmi Is Nothing Then Set wmi = GetObject(REG) 

    If wmi.EnumKey(HKEY_LOCAL_MACHINE, APP_PATH_32, subKeys) = 0 Then 
     If Not IsNull(subKeys) Then found = UBound(Split(Join(subKeys), ID)) > 0 
    End If 
    If Not found Then 
     If wmi.EnumKey(HKEY_LOCAL_MACHINE, APP_PATH_64, subKeys) = 0 Then 
      If Not IsNull(subKeys) Then found = UBound(Split(Join(subKeys), ID)) > 0 
     End If 
    End If 
    AppDetected = found 
End Function 

note: Je ne testé sur une machine sans Outlook

Plus de détails sur WMI Tasks: Registry de MS

---

dans VBScript Une autre version de WMI en utilisant MIME, qui montre installé des applications MS,:

Set wmi = GetObject("winmgmts:\\.\root\CIMV2") 
Set itms = wmi.ExecQuery("SELECT * FROM Win32_MIMEInfoAction", "WQL", &h10 + &h20) 

For Each itm In itms 
    WScript.Echo itm.Name 
Next 

---

détecter MS Mail, similaire à CreateObject: Application.ActivateMicrosoftApp xlMicrosoftMail

---

Déterminer les comptes utilisateur Outlook:

'If Outlook exists, set reference to Microsoft Outlook * 
Public Function ShowOutlookAccount() As Long 
    Dim appOutlook As Outlook.Application, i As Long 

    Set appOutlook = CreateObject("Outlook.Application") 
    For i = 1 To appOutlook.Session.Accounts.Count 
     Debug.Print appOutlook.Session.Accounts.Item(i) & " : Account number " & i 
    Next 
End Function 

---

Plus Outlook utils de Ron de Bruin

Answer 2

Vous pouvez faire quelque chose comme ceci:

Sub Whatever() 
    Dim obj As Object 
    Set obj = CreateObjectType("Outlook.Application") 

    If Not obj Is Nothing Then 
     '... 
    End If 

End Sub 

Public Function CreateObjectType(objectType As Variant) As Object 
    On Error Resume Next 
    CreateObjectType = CreateObject(objectType) 
End Function 

Answer 3

Vous pouvez essayer quelque chose comme alors ...

Dim olApp As Object 
On Error Resume Next 
Set olApp = GetObject(, "Outlook.Application") 
If Err <> 0 Then Set olApp = CreateObject("Outlook.Application") 
On Error GoTo 0 
If olApp Is Nothing Then 
    MsgBox "Outlook is not installed on your system." & vbNewLine & vbNewLine & _ 
     "Please Install & Configure The Outlook And Then Try Again...", vbExclamation, "Outlook Not Installed!" 
    Exit Sub 
End If 

Answer 4

Ceci est ma solution:

Option Explicit 

Sub TestMe() 

    Debug.Print blnObjectInstalled 

End Sub 

Public Function blnObjectInstalled(Optional strObjectType As String = "Outlook.Application") As Boolean 

    On Error GoTo blnobjectInstalled_Error 

    Dim obj As Object 
    Set obj = CreateObject(strObjectType) 

    blnObjectInstalled = True 

    On Error GoTo 0 
    Exit Function 

blnobjectInstalled_Error: 

    blnObjectInstalled = False 

End Function 

L'idée est que nous faisons une fonction booléenne, en définissant si l'objet est installé, en prenant une chaîne optionnelle, ainsi il peut vérifier divers objets. En tant que valeur de chaîne, il est plus facile à vérifier. Faire cela avec des directives de préprocesseur semble impossible, car vous devez définir une constante égale à une fonction qui vérifie si l'Outlook est installé, et les constantes ne l'aiment pas de cette façon.