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

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Charles Racaud)