Beispiel:

Option Explicit
 
Public Declare Function RegCloseKey _
    Lib "advapi32.dll" _
    (ByVal hKey As Long) As Long
 
Public Declare Function GetShortPathName _
    Lib "kernel32.dll" Alias _
    "GetShortPathNameA" _
    (ByVal lpszLongPath As String, _
    ByVal lpszShortPath As String, _
    ByVal cchBuffer As Long) As Long
 
Public Declare Function RegOpenKeyEx _
    Lib "advapi32.dll" Alias _
    "RegOpenKeyExA" _
    (ByVal hKey As Long, _
    ByVal lpSubKey As String, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, _
    phkResult As Long) As Long
 
Public Declare Function RegQueryValueEx _
    Lib "advapi32.dll" Alias _
    "RegQueryValueExA" _
    (ByVal hKey As Long, _
    ByVal sValue As String, _
    ByVal lReserved As Long, _
    lType As Long, _
    ByVal sData As String, _
    lcbData As Long) As Long
 
Public Sub MSInfoPath( _
           sLongPath As String, _
           Optional sShortPath _
           As String = vbNullString)
  '// -----------------------------------------------------
  '// Methode:   | Pfad zur MSInfo.exe ermitteln;
  '//            | benötigt Hilfsfunktion GetKeyValue
  '// -----------------------------------------------------
  '// Parameter: | sLongPath  - Dateipfad zur MSInfo.exe
  '//            | sShortPath - Dateipfad im 8.3-Format
  '// -----------------------------------------------------
  '// Rückgabe:  | s.o.
  '// -----------------------------------------------------
  '// Autor:     | Stefan Kulpa
  '//            | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  '// Beispiel:
  '// Dim sLongPath  As String
  '// Dim sShortPath As String
  '// Call MSInfoPath(sLongPath, sShortPath)
  '// Debug.Print sLongPath
  '// Debug.Print sShortPath
  '// -----------------------------------------------------
  Const HKEY_LOCALMACHINE As Long = &H80000002
  Const REGKEYSYSINFOLOC  As String = _
      "SOFTWARE\Microsoft\Shared Tools Location"
  Const REGKEYSYSINFO     As String = _
      "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  Const REGVALSYSINFOLOC  As String = "MSINFO"
  Const REGVALSYSINFO     As String = "PATH"
  Const APP_SYSINFO       As String = "MSINFO32.EXE"
 
  Dim rc                  As Long
  Dim sBuffer             As String
 
  If GetKeyValue(HKEY_LOCALMACHINE, _
      REGKEYSYSINFO, _
      REGVALSYSINFO, _
      sLongPath) Then
  ElseIf GetKeyValue(HKEY_LOCALMACHINE, _
      REGKEYSYSINFOLOC, _
      REGVALSYSINFOLOC, _
      sLongPath) Then
    If VBA.Right(sLongPath, 1) <> "\" Then
      sLongPath = sLongPath + "\"
    End If
    sLongPath = sLongPath + APP_SYSINFO
  End If
  If Len(sLongPath) > 0 Then
    sBuffer = String(256, 0)
    rc = GetShortPathName(sLongPath, sBuffer, Len(sBuffer))
    If InStr(sBuffer, vbNullChar) > Len(APP_SYSINFO) Then
      sShortPath = VBA.Left(sBuffer, InStr(sBuffer, _
          vbNullChar) - 1)
    End If
  End If
 
End Sub
 
Public Function GetKeyValue(lKeyRoot As Long, _
                            sKeyName As String, _
                            sSubKeyRef As String, _
                            ByRef sKeyVal As String) _
                            As Boolean
 
  Const KEY_ALL_ACCESS    As Long = &H2003F
  Const ERROR_SUCCESS     As Long = 0&
  Const REG_DWORD         As Long = 4
  Const REG_SZ            As Long = 1
 
  Dim lCounter            As Long
  Dim lAPIRes             As Long
  Dim lRegKey             As Long
  Dim lKeyValType         As Long
  Dim lKeyValSize         As Long
  Dim sTmpVal             As String
 
  lAPIRes = RegOpenKeyEx(lKeyRoot, _
      sKeyName, _
      0, _
      KEY_ALL_ACCESS, _
      lRegKey)
 
  If (lAPIRes <> ERROR_SUCCESS) Then GoTo GetKeyError
  sTmpVal = String$(1024, 0)
  lKeyValSize = 1024
 
  lAPIRes = RegQueryValueEx(lRegKey, _
      sSubKeyRef, _
      0, _
      lKeyValType, _
      sTmpVal, _
      lKeyValSize)
 
  If (lAPIRes <> ERROR_SUCCESS) Then GoTo GetKeyError
  sTmpVal = VBA.Left(sTmpVal, InStr(sTmpVal, _
      VBA.Chr(0)) - 1)
 
  Select Case lKeyValType
  Case REG_SZ
    sKeyVal = sTmpVal
  Case REG_DWORD
    For lCounter = Len(sTmpVal) To 1 Step -1
      sKeyVal = _
          sKeyVal + Hex(Asc(Mid(sTmpVal, _
          lCounter, 1)))
    Next
    sKeyVal = Format$("&h" + sKeyVal)
  End Select
  GetKeyValue = True
  lAPIRes = RegCloseKey(lRegKey)
  Exit Function
 
GetKeyError:
  sKeyVal = ""
  GetKeyValue = False
  lAPIRes = RegCloseKey(lRegKey)
 
End Function