Pb récup.Nom Fichiers avec OpenFileName (Sélection Multiple)

Question

Salut
J'aimerais savoir comment faire pour récupérer le nom des
fichiers sélectionnés lorsqu'on utilise l'API GetOpenFileName avec une Sélection Mutiple.

Makabey · Answer

Tiens essaie ceci, il te faudra p-ê corriger un brin:

'
' Global:
'
Private lclLastFlags As Long  'Les derniers flags utilisés, pour certaines références internes.

'
' Dans ta fonction qui appelle GetOpenFileName
'
  'Backup des flags juste avant...
  lclLastFlags = lclOpenFile.flags
  
  ShowOpen = GetOpenFileName(lclOpenFile)
  
  'Test:
  Debug.Print "File: " & lclOpenFile.lpstrFile
  Debug.Print "FileTitle: " & lclOpenFile.lpstrFileTitle
  '/Test
  
  ' Réduire la chaine à taille réelle, c'est à dire, retirer sur
  ' les 257 caractères réservés, ceux inutilisés.
  lclOpenFile.lpstrFileTitle = Left$(lclOpenFile.lpstrFileTitle, MK_CDC_LenAsciiZ(lclOpenFile.lpstrFileTitle))
  
  'Analyser le retour pour .FileName et voir si on voulais plusieurs fichiers...
  If (LenB(lclOpenFile.lpstrFileTitle) = 0) Then
      If (lclLastFlags And cdlALLOWMULTISELECT) Then
          If (lclLastFlags And cdlEXPLORER) Then
              ' Réduire les chaines à leurs taille réelles, c'est à dire, retirer sur
              ' les 257 caractères réservés, ceux inutilisés.
              lclOpenFile.lpstrFile = Left$(lclOpenFile.lpstrFile, MK_CDC_LenAsciiZRev(lclOpenFile.lpstrFile))
              
              'Puisque le "?" est interdit dans un nom de fichier,
              'on l'utilise pour séparer les noms...
              lclOpenFile.lpstrFile = Replace(lclOpenFile.lpstrFile, Chr$(0), "?")
              
              '  L'usager pourra appeller FileNameList pour avoir les noms...
            Else
              ' Réduire la chaine à taille réelle, c'est à dire, retirer sur
              ' les 257 caractères réservés, ceux inutilisés.
              lclOpenFile.lpstrFile = Left$(lclOpenFile.lpstrFile, MK_CDC_LenAsciiZ(lclOpenFile.lpstrFile))
              
              'Puisque le "?" est interdit dans un nom de fichier,
              'on l'utilise pour séparer les noms...
              lclOpenFile.lpstrFile = Replace(lclOpenFile.lpstrFile, " ", "?")
              
              '  L'usager pourra appeller FileNameList pour avoir les noms...
          End If
        Else
          'Une erreur s'est produite, FileTitle est vide mais
          'flags<>cdlALLOWMULTISELECT alors que il devrait l'être!
          lclOpenFile.lpstrFile = vbNullString
          ShowOpen = 2
      End If
    Else
      ' Réduire la chaine à taille réelle, c'est à dire, retirer sur
      ' les 257 caractères réservés, ceux inutilisés.
      lclOpenFile.lpstrFile = Left$(lclOpenFile.lpstrFile, MK_CDC_LenAsciiZ(lclOpenFile.lpstrFile))
  End If

'
' Fonctions de support:
'
Private Function MK_CDC_LenAsciiZ(ByRef Chaine As String) As Long
  '
  ' Détermine la position du dernier caractère non égal à Chr(0) ou
  ' NULL/VBNull à partir du DÉBUT et renvois la longueur de la chaine.
  '
  
  Dim Longueur1 As Long
  Dim TstChar1 As Variant
  
  Longueur1 = Len(Chaine)
  MK_CDC_LenAsciiZ = 0
  
  If Longueur1 = 0 Then Exit Function
  
  Do
    MK_CDC_LenAsciiZ = MK_CDC_LenAsciiZ + 1
    TstChar1 = Mid$(Chaine, MK_CDC_LenAsciiZ, 1)  Loop Until ((MK_CDC_LenAsciiZ Longueur1) Or (TstChar1 Chr$(0))) 'Or (IsNull(TstChar1))
  
  ' Au cas que MK_CDC_LenAsciiZ = Longueur1 pour éviter de couper le dernier caractère...
  If (MK_CDC_LenAsciiZ < Longueur1) Then
      MK_CDC_LenAsciiZ = MK_CDC_LenAsciiZ - 1
    'Else
  End If
  
End Function

Private Function MK_CDC_LenAsciiZRev(ByRef Chaine As String) As Long
  '
  ' Détermine la position du dernier caractère non égal à Chr(0) ou
  ' NULL/VBNull à partir de la FIN et renvois la longueur de la chaine.
  '
  
  Dim Longueur1 As Long
  Dim TstChar1 As Variant
  
  Longueur1 = Len(Chaine)
  MK_CDC_LenAsciiZRev = Longueur1
  
  If Longueur1 = 0 Then Exit Function
  
  Do
    MK_CDC_LenAsciiZRev = MK_CDC_LenAsciiZRev - 1
    TstChar1 = Mid$(Chaine, MK_CDC_LenAsciiZRev, 1)
  Loop Until ((MK_CDC_LenAsciiZRev = 0) Or (StrComp(TstChar1, Chr$(0)) <> 0)) 'or (Not IsNull(TstChar1)))

End Function

Public Function FileNameList(ByRef OutList() As String) As Integer
  '
  ' Retourne le nom des fichiers sélectionnés lorsque .flags
  ' contient cdlALLOWMULTISELECT
  '
  ' Si .flags ne contient pas cdlALLOWMULTISELECT retourne 0,
  ' Si erreur interne #1: incapable de déterminer NomRep, retourne -1,
  ' sinon le nombre d'éléments.
  '
  Dim NomRep As String
  Dim lPos As Long
  Dim lPos2 As Long
  Dim iCmpt As Integer   'Compte le nombre exact de noms
  Dim iEle As Integer   'Le nombre de cellules que contient OutList
    
  If ((lclLastFlags And cdlALLOWMULTISELECT) = 0) Then
      FileNameList = 0
      Exit Function
    'Else
  End If
    
  lPos = InStr(1, lclOpenFile.lpstrFile, "?", vbBinaryCompare)
  If (lPos = 0) Then
      FileNameList = -1
      Exit Function
    'Else
  End If
  
  NomRep = Left$(lclOpenFile.lpstrFile, lPos - 1)
  If (StrComp(Right$(NomRep, 1), "", vbBinaryCompare) <> 0) Then
      NomRep = NomRep & ""
    'Else
  End If
  
  lPos2 = lPos + 1
  
  lPos = InStr(lPos2, lclOpenFile.lpstrFile, "?", vbBinaryCompare)
  ReDim OutList(20)
  iCmpt = LBound(OutList)  'Prémunir contre "Option Base 1"
  iEle = 20
  Do
    OutList(iCmpt) = NomRep & Mid$(lclOpenFile.lpstrFile, lPos2, lPos - lPos2)
    
    iCmpt = iCmpt + 1
    'Si à la limite, alors on agrandit...
    If (iCmpt > iEle) Then
        iEle = iEle + 20
        If (iEle >= 32000) Then Exit Function 'on limite à +/-32000 éléments...
        ReDim Preserve OutList(iEle)
      'Else
    End If
    lPos2 = lPos + 1
    lPos = InStr(lPos2, lclOpenFile.lpstrFile, "?", vbBinaryCompare)
  Loop Until (lPos = 0)
  OutList(iCmpt) = NomRep & Right$(lclOpenFile.lpstrFile, Len(lclOpenFile.lpstrFile) - lPos2 + 1)
  ReDim Preserve OutList(iCmpt)
  FileNameList = iCmpt + 1 - LBound(OutList)
  
End Function

Pb récup.Nom Fichiers avec OpenFileName (Sélection Multiple)

1 réponse

Discussions similaires