Determine which version of a program exists on the current system (acrobat pro)

[MXCTRL]

I have a macro obtained from this forum (THANK YOU!) which allows me to print a list of pdfs. However, in order for this to work, I have to hard code the filepath (and hence version) of adobe acrobat being used on my system.

How do I build into the macro a routine which will search a given computer and determine which version of acrobat exists on that particular machine, and then uses the correct program call?

My issue is that the same worksheet is used by many different users who do not all have the same version of Acrobat Pro (some 10.0 some 11.0) I don't want to have to maintain different versions of the worksheet to accommodate the different versions of Acrobat Pro.

Help!

 

[pbornemeier]

This site has code that lists most installed software and their locations to a worksheet. Parse it for Acrobat.
http://www.myengineeringworld.net/2013/05/excel-VBA-list-all-computer-software.html

 

[pbornemeier]

You can use this to get a full listing of the msi installed items on your computer:

Sub FullListing()

    Dim objFSO As Object
    Dim objTextFile As Object
    Dim strComputer As String
    Dim objWMIService As Object
    Dim colSoftware As Variant
    Dim objSoftware As Object
    Dim sOutputFile As String
    
    sOutputFile = Environ("temp") & "\TempFileInfoFile.txt"

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTextFile = objFSO.CreateTextFile(sOutputFile, True)
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colSoftware = objWMIService.ExecQuery _
     ("SELECT * FROM Win32_Product")
     
    'Write Header to File
    objTextFile.WriteLine "Name" & vbTab & "Version" & vbTab & "Vendor" & vbTab & _
        "Caption" & vbTab & "Description" & vbTab & _
        "IdentifyingNumber" & vbTab & "InstallDate" & vbTab & _
        "InstallDate2" & vbTab & "InstallLocation" & vbTab & _
        "InstallState" & vbTab & "HelpLink" & vbTab & _
        "HelpTelephone" & vbTab & _
        "InstallSource" & vbTab & _
        "Language" & vbTab & _
        "LocalPackage" & vbTab & _
        "PackageCache" & vbTab & _
        "PackageCode" & vbTab & _
        "PackageName" & vbTab & _
        "ProductID" & vbTab & _
        "RegOwner" & vbTab & _
        "RegCompany" & vbTab & _
        "SKUNumber" & vbTab & _
        "Transforms" & vbTab & _
        "URLInfoAbout" & vbTab & _
        "URLUpdateInfo" & vbTab & _
        "WordCount"
    
    'Write Data to File
    For Each objSoftware In colSoftware
    objTextFile.WriteLine objSoftware.Name & vbTab & objSoftware.Version & vbTab & objSoftware.Vendor & vbTab & _
        objSoftware.Caption & vbTab & objSoftware.Description & vbTab & _
        objSoftware.IdentifyingNumber & vbTab & objSoftware.InstallDate & vbTab & _
        objSoftware.InstallDate2 & vbTab & objSoftware.InstallLocation & vbTab & _
        objSoftware.InstallState & vbTab & objSoftware.HelpLink & vbTab & _
        objSoftware.HelpTelephone & vbTab & _
        objSoftware.InstallSource & vbTab & _
        objSoftware.Language & vbTab & _
        objSoftware.LocalPackage & vbTab & _
        objSoftware.PackageCache & vbTab & _
        objSoftware.PackageCode & vbTab & _
        objSoftware.PackageName & vbTab & _
        objSoftware.ProductID & vbTab & _
        objSoftware.RegOwner & vbTab & _
        objSoftware.RegCompany & vbTab & _
        objSoftware.SKUNumber & vbTab & _
        objSoftware.Transforms & vbTab & _
        objSoftware.URLInfoAbout & vbTab & _
        objSoftware.URLUpdateInfo & vbTab & _
        objSoftware.WordCount
    Next
    
    objTextFile.Close

    AddSheet sOutputFile
    
    Kill sOutputFile

End Sub

Private Sub AddSheet(sOutputFile As String)

    Dim oWS As Worksheet
    Dim strComputer As String
    
    Application.DisplayAlerts = False
    On Error Resume Next
    Worksheets("M4").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    
    
    Set oWS = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    With oWS
        .Name = "M4"
        .Range("$A$1") = "Computer : " & strComputer
        
        'Ensure Text-to-Column has Tab as True and Space as False
        Range("A1").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, _
            FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

        .Range("a1").Font.Bold = True
        .QueryTables.Add(Connection:="TEXT;" _
        & sOutputFile, Destination:=oWS.Range("$A$2")).Refresh
    End With
    
End Sub

Then when you figure out the exact name of the product in one of the fields, modify the

     ("SELECT * FROM Win32_Product WHERE (vendor like 'Adobe%')")

statement to search that field ...

perhaps to

("SELECT * FROM Win32_Product WHERE (caption like 'Adobe Acrobat Professional%')")

and use the following to return the item(s) that you need:

Sub Test_ReturnVersion()

    Dim x
    x = ReturnVersion
    Stop
    
End Sub

Function ReturnVersion() As Variant

    Dim objFSO As Object
    Dim objTextFile As Object
    Dim strComputer As String
    Dim objWMIService As Object
    Dim colSoftware As Variant
    Dim objSoftware As Object
    Dim sOutputFile As String
    Dim aryOutput() As Variant
    Dim lOutputIndex As Long
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colSoftware = objWMIService.ExecQuery _
     ("SELECT * FROM Win32_Product WHERE (vendor like 'Adobe%')")
    For Each objSoftware In colSoftware
        lOutputIndex = lOutputIndex + 1
        ReDim Preserve aryOutput(1 To 3, 1 To lOutputIndex)
        aryOutput(1, lOutputIndex) = objSoftware.Caption
        aryOutput(2, lOutputIndex) = objSoftware.Version
        aryOutput(3, lOutputIndex) = objSoftware.InstallLocation
    Next
        
    ReturnVersion = aryOutput
    
End Function