Selection multiple avec GetOpenFilename

[franck17]

Bonsoir le Forum

Comment faire pour selectionner plusieurs fichiers avec GetOpenFilname:
pour pouvoir copier des fichiers d'un répertoire A vers un répertoire B ?
Et est il possible de rajouter un boite de dialogue avec demande d'écrasement si fichiers deja présents ?

Voir fichier joint pour voir la macro.

Merci de votre aide et bonne soirée.

 

[MichelXld]

Re : Selection multiple avec GetOpenFilename

bonsoir


J'espère que cet exemple pourra t'aider

Option Explicit

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" _
    (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" _
    (lpBrowseInfo As BROWSEINFO) As Long

Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

'-----------------------------*------------------------------*--
Function GetFolder(Optional ByVal Name As String = _
"Select a folder.") As String
'-----------------------------*------------------------------*--
'http://www.excelforum.com//showthread.php?t=356307
'
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim oDialog As Long
    
    bInfo.pidlRoot = 0& 'Root folder = Desktop
    bInfo.lpszTitle = Name
    bInfo.ulFlags = &H1 'Type of directory to Return
    
    oDialog = SHBrowseForFolder(bInfo) 'display the dialog
    path = Space$(512) 'Parse the result
    
    GetFolder = ""
    If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
        GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
End If
End Function

 
Sub Test()
    Dim Fichiers As Variant
    Dim i As Integer
    Dim Chemin As String
    Dim Fso As Object
    
    'Sélection des fichiers
    Fichiers = Application.GetOpenFilename(, , , , True)
    
    If IsArray(Fichiers) Then
    
        '--- Sélection repertoire ---
        Chemin = GetFolder
        If Chemin = "" Then Exit Sub
        '-----------------------------
       
        Set Fso = CreateObject("Scripting.FileSystemObject")
        'Transfert fichiers
        For i = 1 To UBound(Fichiers)
            'True pour écraser les fichiers existants
            Fso.CopyFile Fichiers(i), Chemin & "\", True
        Next
    End If
End Sub

Bonne soirée
MichelXld

 

[franck17]

Re : Selection multiple avec GetOpenFilename

Bonsoir Michelxld

Merci pour ton code je vais essayer de le bricoler pour mon application mais c'est pas gagné j'aurais peut etre encore besoin d'aide.

Merci et bonne soirée

 

[neo2k2]

Re : Selection multiple avec GetOpenFilename

Bonsoir Michelxld

Merci pour ton code je vais essayer de le bricoler pour mon application mais c'est pas gagné j'aurais peut etre encore besoin d'aide.

Merci et bonne soirée

Il faut utiliser la méthode "GetOpenFilename" qui permet d'afficher la boîte de dialogue "Ouvrir" et de lire le(s) fichier(s) sélectionné(s). Cette méthode renvoie le(s) nom(s) de fichier(s) spécifié(s) par l'utilisateur.

Pour permettre d'effectuer une sélection multiple de fichiers, il faut utiliser l'argument "multiSelect" ; les quatre premiers arguments étant facultatif. Si cet argument est égal à True, vous pouvez sélectionner plusieurs noms de fichiers et la valeur renvoyée est un tableau Visual Basic Edition Applications des noms de fichiers activés (même si un seul nom de fichier a été sélectionné) . Si il est à False ou omis, vous ne pouvez sélectionner qu'un seul nom de fichier.

Cette méthode renvoie False si l'utilisateur annule la boîte de dialogue.

Dans l'exemple ci-dessous, je teste si la variable "FichiersAOuvrir" renvoie un tableau. Si c'est le cas, le(s) fichier(s) spécifié(s) sont ouverts. Dans le cas contraire, par exemple si j'ai annulé la boîte de dialogue "Ouvrir", le message "Annuler" apparaît.


' Code Visual Basic anglais
Sub FileName()
' pour changer de répertoire courant
ChDrive "D:\" 'si l'on souhaite utiliser le lecteur D, donc à adapter
ChDir "D:\foo" 'si l'on souhaite utiliser le dossier foo, donc à adapter
'
FichiersAOuvrir = Application.GetOpenFilename(, , , , True)
If IsArray(FichiersAOuvrir) Then
For i = LBound(FichiersAOuvrir, 1) To UBound(FichiersAOuvrir, 1)
'Ouvre les fichiers sélectionnés
Workbooks.Open FichiersAOuvrir(i)
Next i
Else
MsgBox "Annuler"
End If
End Sub

cf : http://support.microsoft.com/kb/465507/fr

 

[L@russeE3]

Bonsoir,
j'ai un soucis.
J'ai un répertoire de 07 fichiers dont je dois copier le contenu pour mettre dans une base de données.
J'ai fait un code qui marche cependant la condition est qu'il ne doit manquer aucun des 07 fichiers et sachant que parfois on me livre pas tous les 07 fichiers, je suis obligée de modifier le code tout le temps. .
J'aurais besoin de savoir comment faire pour copier le contenu des fichiers même s'il ne sont pas à 07. Une façon de dire au code de copier le contenu des fichiers qu'il voit, peu importe le nombre, du moment que ça fait parti des 07 fichiers qui devraient normalement être copiés

 

[Deadpool_CC]

Bonsoir,
j'ai un soucis.
J'ai un répertoire de 07 fichiers dont je dois copier le contenu pour mettre dans une base de données.
J'ai fait un code qui marche cependant la condition est qu'il ne doit manquer aucun des 07 fichiers et sachant que parfois on me livre pas tous les 07 fichiers, je suis obligée de modifier le code tout le temps. .
J'aurais besoin de savoir comment faire pour copier le contenu des fichiers même s'il ne sont pas à 07. Une façon de dire au code de copier le contenu des fichiers qu'il voit, peu importe le nombre, du moment que ça fait parti des 07 fichiers qui devraient normalement être copiés

ouvre une nouvelle question ... ne réactive pas un post de 2007