Kiểm tra sự tồn tại của các gói ứng dụng trong MS Office

[hai2hai]

Private Function OutlookExists() As Integer
    On Error Resume Next
    
    Dim objOutlook As Object
    Dim intExists As Integer
    
    'try to create a new instance of MS Outlook
    Set objOutlook = CreateObject("Outlook.Application")
    
    'if the instance of MS Outlook does not exist then MS Outlook is not installed
    If objOutlook Is Nothing Then
        intExists = 0
        
    'else, MS Outlook is installed
    Else
        intExists = 1
    End If
    
    'distroy the object
    Set objOutlook = Nothing
    
    'return the status of MS Outlook being installed
    OutlookExists = intExists
End Function

Private Function WordExists() As Integer
    On Error Resume Next
    
    Dim objWord As Object
    Dim intExists As Integer
    
    'try to create a new instance of MS Word
    Set objWord = CreateObject("Word.Application")
    
    'if the instance of MS Word does not exist then MS Word is not installed
    If objWord Is Nothing Then
        intExists = 0
        
    'else, MS Word is installed
    Else
        intExists = 1
    End If
    
    'distroy the object
    Set objWord = Nothing
    
    'return the status of MS Word being installed
    WordExists = intExists
End Function

Private Function ExcelExists() As Integer
    On Error Resume Next
    
    Dim objExcel As Object
    Dim intExists As Integer
    
    'try to create a new instance of MS Excel
    Set objExcel = CreateObject("Excel.Application")
    
    'if the instance of MS Excel does not exist then MS Excel is not installed
    If objExcel Is Nothing Then
        intExists = 0
        
    'else, MS Excel is installed
    Else
        intExists = 1
    End If
    
    'distroy the object
    Set objExcel = Nothing
    
    'return the status of MS Excel being installed
    ExcelExists = intExists
End Function

Private Function PowerPointExists() As Integer
    On Error Resume Next
    
    Dim objPowerPoint As Object
    Dim intExists As Integer
    
    'try to create a new instance of MS PowerPoint
    Set objPowerPoint = CreateObject("PowerPoint.Application")
    
    'if the instance of MS PowerPoint does not exist then MS PowerPoint is not installed
    If objPowerPoint Is Nothing Then
        intExists = 0
        
    'else, MS PowerPoint is installed
    Else
        intExists = 1
    End If
    
    'distroy the object
    Set objPowerPoint = Nothing
    
    'return the status of MS PowerPoint being installed
    PowerPointExists = intExists
End Function

Private Function AccessExists() As Integer
    On Error Resume Next
    
    Dim objAccess As Object
    Dim intExists As Integer
    
    'try to create a new instance of MS Access
    Set objAccess = CreateObject("Access.Application")
    
    'if the instance of MS Access does not exist then MS Access is not installed
    If objAccess Is Nothing Then
        intExists = 0
        
    'else, MS Access is installed
    Else
        intExists = 1
    End If
    
    'distroy the object
    Set objAccess = Nothing
    
    'return the status of MS Access being installed
    AccessExists = intExists
End Function

--------------

Test:

Private Sub Command1_Click()
    MsgBox "Outlook Exists " & OutlookExists
    MsgBox "Word Exists " & WordExists
    MsgBox "Excel Exists " & ExcelExists
    MsgBox "Powerpoint Exists " & PowerPointExists
    MsgBox "Access Exists " & AccessExists
End Sub

P/S: Cách CreateObject("ObjectName") là cách tạo LateBound Object, mọi người chắc biết rồi chứ?