Code to open a program by name

[Excelpromax123]

Hi everyone, I'm from Vietnam, so I use Google Translate, so the words may be difficult to understand, hope everyone understands. I need a code to open a program name (because the path often changes), so I can't get the path but have to get the program name

Currently I am using this code but this code is only Off, if you want to change it to On, then edit it somewhere. Sincerely thank!

Function TaskKill(sTaskName)
    TaskKill = CreateObject("WScript.Shell").Run("taskkill /f /im " & sTaskName, 0, True)
End Function

Sub turnoffthe program()
On Error Resume Next
TaskKill ("Notepad.exe")
End Sub

 

[GWteB]

@johnnyL, your code doesn't take into account there could be multiple files with the same name in different folder locations. It just returns the first occurence, assuming thats the right one.
On my system it turned out that there are twelve occurences of mspaint.exe and eleven of notepad.exe. It failed on mspaint and the launched notepad didn't have a taskbar icon.
The way @Jaafar Tribak probably would go, searching within the Windows Registry based on file association would be a better one.

 

[johnnyL]

Ok now it opens the files with the program associated with the file:

Sub GetPathToFileNameAndExecutev2()
'
'   This macro should be able to find the location of any file on your C drive if you provide the name and file extention to look for.
'   It will display the CMD black box while it is searching, May take a minute or two to find the location.
'
    Dim FileName        As String
    Dim FilePath        As String
    Dim retVal          As String
    Dim ExecuteProgram  As Variant
'
    FileName = "mspaint.exe"                        ' <--- Set this to the file name and extention that you are looking for
''    FileName = "AdwCleaner[C00].txt"                    ' <--- Set this to the file name and extention that you are looking for
'
    retVal = Split(CreateObject("WScript.Shell").Exec("CMD /C FOR /r ""C:\"" %i IN (*" & FileName & ") DO (ECHO %i)").StdOut.ReadAll, vbCrLf)(2)
'
    FilePath = Left$(retVal, InStrRev(retVal, "\"))
'
    CreateObject("Shell.Application").Open (FilePath & FileName)
End Sub

 

[johnnyL]

@johnnyL, your code doesn't take into account there could be multiple files with the same name in different folder locations. It just returns the first occurence, assuming thats the right one.
On my system it turned out that there are twelve occurences of mspaint.exe and eleven of notepad.exe. It failed on mspaint and the launched notepad didn't have a taskbar icon.
The way @Jaafar Tribak probably would go, searching within the Windows Registry based on file association would be a better one.

I realize it executes the first occurrence found. It would take some more coding to solve that issue. Have you tried the last bit of code I provided? It opens the file searched for with the program that is associated with it. Please try that to see if it resolves some issues you faced.

 

[GWteB]

Ok now it opens the files with the program associated with the file:

It certainly does, but we are now slightly deviating from the OP's question. In addition, after a long wait before it appears on the screen we still do not know what the program's folder path is.

 

[johnnyL]

It certainly does, but we are now slightly deviating from the OP's question. In addition, after a long wait before it appears on the screen we still do not know what the program's folder path is.

This Better?

Sub GetPathToFileNameAndExecutev3()
'
'   This macro should be able to find the location of any file on your C drive if you provide the name and file extention to look for.
'   It will display the CMD black box while it is searching, May take a minute or two to find the location.
'
    Dim FileName        As String
    Dim FilePath        As String
    Dim retVal          As String
    Dim ExecuteProgram  As Variant
'
    FileName = "mspaint.exe"                        ' <--- Set this to the file name and extention that you are looking for
''    FileName = "AdwCleaner[C00].txt"                    ' <--- Set this to the file name and extention that you are looking for
'
    retVal = Split(CreateObject("WScript.Shell").Exec("CMD /C FOR /r ""C:\"" %i IN (*" & FileName & ") DO (ECHO %i)").StdOut.ReadAll, vbCrLf)(2)
'
    FilePath = Left$(retVal, InStrRev(retVal, "\"))
'
Debug.Print FilePath
    CreateObject("Shell.Application").Open (FilePath & FileName)
MsgBox FilePath
End Sub

 

[johnnyL]

Hi everyone, I'm from Vietnam, so I use Google Translate, so the words may be difficult to understand, hope everyone understands. I need a code to open a program name (because the path often changes), so I can't get the path but have to get the program name

 

[GWteB]

IMO it would be fair to let the OP judge that ...

 

[Jaafar Tribak]

The FindExecutable api should find the executable path most of the time but, for a more consistent method, I would use the SHAssocEnumHandlers api as follows:

In a Standard Module:

Option Explicit

Private Enum ASSOC_FILTER
    ASSOC_FILTER_NONE = &H0
    ASSOC_FILTER_RECOMMENDED = &H1
End Enum

#If VBA7 Then
    Private Declare PtrSafe Function SHAssocEnumHandlers Lib "shell32" (ByVal pszExtra As LongPtr, ByVal afFilter As ASSOC_FILTER, ByVal ppEnumHandler As LongPtr) As Long
    Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
    Private Declare PtrSafe Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare PtrSafe Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
#Else
    Private Declare Function SHAssocEnumHandlers Lib "shell32" (ByVal pszExtra As Long, ByVal afFilter As ASSOC_FILTER, ByVal ppEnumHandler As Long) As Long
    Private Declare Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long
    Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
#End If


Function FindExecutable_With_AssocHandlerINTERFACE(ByVal DocumetFileExtension As String) As String

    #If Win64 Then
        Const vTblOffsetFac_32_64 = 2&
        Dim pEnumHandlers As LongLong
        Dim pAssocHandler As LongLong
         Dim pceltFetched As LongLong
        Dim pExecutablePathName As LongLong
    #Else
        Const vTblOffsetFac_32_64 = 1&
        Dim pEnumHandlers As Long
        Dim pAssocHandler As Long
        Dim pceltFetched As Long
        Dim pExecutablePathName As Long
    #End If
 
    Const IEnumAssocHandlers_Next = 12 * vTblOffsetFac_32_64
    Const IAssocHandler_GetName = 12 * vTblOffsetFac_32_64
    Const CC_STDCALL = 4&
    Const S_OK = 0&
 
    Dim Unk As IUnknown

    If Len(DocumetFileExtension) Then
        DocumetFileExtension = IIf(Left(DocumetFileExtension, 1) = ".", DocumetFileExtension, "." & DocumetFileExtension)
        If SHAssocEnumHandlers(StrPtr(DocumetFileExtension), ASSOC_FILTER_RECOMMENDED, VarPtr(Unk)) = S_OK Then
            pEnumHandlers = ObjPtr(Unk)
            If vtblCall(pEnumHandlers, IEnumAssocHandlers_Next, vbLong, CC_STDCALL, 1&, VarPtr(pAssocHandler), VarPtr(pceltFetched)) = S_OK Then
                If vtblCall(pAssocHandler, IAssocHandler_GetName, vbLong, CC_STDCALL, VarPtr(pExecutablePathName)) = S_OK Then
                    FindExecutable_With_AssocHandlerINTERFACE = GetStrFromPtrW(pExecutablePathName)
                End If
            End If
        End If
    End If

End Function


#If Win64 Then
    Private Function vtblCall(ByVal InterfacePointer As LongLong, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant

    Dim vParamPtr() As LongLong
#Else
    Private Function vtblCall(ByVal InterfacePointer As Long, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant

    Dim vParamPtr() As Long
#End If

    If InterfacePointer = 0& Or VTableOffset < 0& Then Exit Function
    If Not (FunctionReturnType And &HFFFF0000) = 0& Then Exit Function

    Dim pIndex As Long, pCount As Long
    Dim vParamType() As Integer
    Dim vRtn As Variant, vParams() As Variant

    vParams() = FunctionParameters()
    pCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
    If pCount = 0& Then
        ReDim vParamPtr(0 To 0)
        ReDim vParamType(0 To 0)
    Else
        ReDim vParamPtr(0 To pCount - 1&)
        ReDim vParamType(0 To pCount - 1&)
        For pIndex = 0& To pCount - 1&
            vParamPtr(pIndex) = VarPtr(vParams(pIndex))
            vParamType(pIndex) = VarType(vParams(pIndex))
        Next
    End If
 
    pIndex = DispCallFunc(InterfacePointer, VTableOffset, CallConvention, FunctionReturnType, pCount, vParamType(0), vParamPtr(0), vRtn)
    If pIndex = 0& Then
        vtblCall = vRtn
    Else
        SetLastError pIndex
    End If

End Function


#If Win64 Then
    Private Function GetStrFromPtrW(ByVal Ptr As LongLong) As String
#Else
    Private Function GetStrFromPtrW(ByVal Ptr As Long) As String
#End If

    SysReAllocString VarPtr(GetStrFromPtrW), Ptr

End Function

Code usage example:

Sub Test()
    'Find Notepad path.
    MsgBox FindExecutable_With_AssocHandlerINTERFACE(DocumetFileExtension:="txt")
End Sub