Saturday 5 May 2018

VBA - Windows - Code to see if exe is reachable with Path environment variable

I'm trying to run a program called midl.exe but it currently complains that it cannot find the program cl.exe which means I need to triage my Path environment variable so it can be reached. It occurred to me that it would be nice to mimic/predict Windows behaviour as it walks the directories of the Path environment variable. Luckily SO comes to the rescue and yields the PathFindOnPath windows api function.

We can write some client VBA code to call this WinApi function, here it is

Option Explicit

'// https://msdn.microsoft.com/en-us/library/bb773594%28VS.85%29.aspx
Declare Function PathFindOnPath Lib "SHLWAPI.DLL" Alias "PathFindOnPathA" (ByVal pszFile As String, ppszOtherDirs As String) As Long
'BOOL PathFindOnPath(
'  _Inout_  LPTSTR  pszFile,
'  _In_opt_ LPCTSTR *ppszOtherDirs
');

Function PathFindOnPathShim(ByVal pszFile As String, ByVal ppszOtherDirs As String, ByRef sResult As String) As Boolean
    Dim lRetval As Long, sBuffer As String
    
    sBuffer = Left$(pszFile & String$(256, vbNullChar), 256)
    
    lRetval = PathFindOnPath(sBuffer, ppszOtherDirs)
    If lRetval = 1 Then
        sResult = Mid$(sBuffer, 1, InStr(sBuffer, vbNullChar))
        PathFindOnPathShim = True
    Else
        sResult = ""
        PathFindOnPathShim = False
    End If
End Function


Sub TestPathFindOnPathShim()
    
    Dim sFile As String, sOtherDirs As String, sResult As String
    
    sFile = "cl.exe"
    sOtherDirs = "C:\Program Files (x86)\Microsoft Visual Studio 12.0\VC\bin"
    
    If PathFindOnPathShim(sFile, sOtherDirs, sResult) Then
        Debug.Print sResult
    Else
        Debug.Print "not reachable via %PATH%"
    End If

End Sub

Sub WritePathEnvToSheet()

    Dim sPath As String
    sPath = Environ$("PATH")
    
    Dim vSplit As Variant
    vSplit = VBA.Split(sPath, ";")
    
    Dim vPastable As Variant
    vPastable = Application.Transpose(vSplit)
    
    Sheet1.Cells(1, 1).Resize(UBound(vSplit) - LBound(vSplit) + 1, 1).Value2 = vPastable
    Stop


End Sub

No comments:

Post a Comment