Corriger la casse d'un chemin d'accès

Commenter

Contenu du snippet 

Private Const MAX_PATH As Long = 260
Private Const S_OK As Long = &H0

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListW" (ByVal pidl As Long, ByVal pszPath As Long) As Long
Private Declare Function SHParseDisplayName Lib "shell32.dll" (ByVal pszName As Long, ByVal pbc As Long, ByRef ppidl As Long, ByVal sfgaoIn As Long, ByRef psfgaoOut As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Function FixPathCase(ByVal path As String) As String
  Dim newPath As String
  Dim ppidl As Long
  Dim psfgaoOut As Long
  Dim result As Long
  newPath = VBA.String$(MAX_PATH, VBA.Chr$(0))
  FixPathCase = vbNullString
  result = SHParseDisplayName(StrPtr(path), 0&, ppidl, 0&, psfgaoOut)
  If result = S_OK Then
    Dim r As Boolean
    r = SHGetPathFromIDList(ppidl, StrPtr(newPath))
    Call CoTaskMemFree(ppidl)
    If r Then
      Dim length As Long
      length = VBA.InStr(newPath, VBA.Chr$(0))
      If length > 0 Then
        FixPathCase = VBA.Left$(newPath, length - 1)
      End If
    End If
  End If
End Function

Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

Du même auteur (Charles Racaud)