'Voici le code de la form qui vous permet d'intégrer
'une fenêtre de copie de fichiers à votre application.
'
'COMMENT RECUPERER CE CODE ?
'1 - Enregistrez ce fichier sur votre ordinateur.
'2 - Renommez le avec une extension FRM.
'3 - Démarrer un nouveau projet Visual Basic* ou ouvrez un projet existant.
'4 - Ajoutez le fichier à ce projet.
'5 - Double-cliquez sur la form dans l'explorateur de projet pour afficher la form.
'
'
'*propriété de MicroSoft
'
'********************* VOICI LE CODE DE LA FORM **************************
'
VERSION 5.00
Begin VB.Form frmCopierDossier 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Copier dans un dossier"
   ClientHeight    =   4275
   ClientLeft      =   5160
   ClientTop       =   3600
   ClientWidth     =   3960
   Icon            =   "frmCopierDossier.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4275
   ScaleWidth      =   3960
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton Boutons 
      Caption         =   "&Nouveau"
      Height          =   375
      Index           =   2
      Left            =   2640
      TabIndex        =   7
      ToolTipText     =   "Nouveau dossier"
      Top             =   3840
      Width           =   1275
   End
   Begin VB.CommandButton Boutons 
      Cancel          =   -1  'True
      Caption         =   "&Fermer"
      Height          =   375
      Index           =   1
      Left            =   1320
      TabIndex        =   6
      ToolTipText     =   "Quitter"
      Top             =   3840
      Width           =   1275
   End
   Begin VB.CommandButton Boutons 
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   375
      Index           =   0
      Left            =   60
      TabIndex        =   4
      ToolTipText     =   "Valider"
      Top             =   3840
      Width           =   1215
   End
   Begin VB.TextBox txtDossier 
      Height          =   315
      Left            =   780
      TabIndex        =   3
      ToolTipText     =   "Dossier actif"
      Top             =   3300
      Width           =   3135
   End
   Begin VB.DriveListBox Drive1 
      Appearance      =   0  'Flat
      Height          =   315
      Left            =   60
      TabIndex        =   1
      ToolTipText     =   "Liste des lecteurs"
      Top             =   300
      Width           =   3855
   End
   Begin VB.DirListBox Dir1 
      Height          =   2565
      Left            =   60
      TabIndex        =   0
      ToolTipText     =   "Liste des dossiers"
      Top             =   660
      Width           =   3855
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00E0E0E0&
      X1              =   60
      X2              =   3915
      Y1              =   3720
      Y2              =   3735
   End
   Begin VB.Line Line1 
      BorderWidth     =   2
      X1              =   60
      X2              =   3915
      Y1              =   3720
      Y2              =   3735
   End
   Begin VB.Label lblInformation 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Sélectionnez un dossier:"
      Height          =   195
      Left            =   60
      TabIndex        =   5
      ToolTipText     =   "Sélectionnez un dossier:"
      Top             =   60
      Width           =   1725
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Dossier:"
      Height          =   195
      Left            =   60
      TabIndex        =   2
      Top             =   3420
      Width           =   570
   End
End
Attribute VB_Name = "frmCopierDossier"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'
Private tab_Fichiers() As String 'tableau contenant la liste des fichiers selectionnes
Public Chemin As String ' chemin des fichiers selectionnes
Public zone_fichiers As FileListBox
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
'

Private Sub Boutons_Click(Index As Integer)
'
Select Case Index
    Case 0 'OK
        'copie des fichiers
        Dim I%
        Dim dossier$
        Dim retour&
        Dim reponse%
        Dim ecrasement As Boolean
        dossier = Dir1.Path
        If Right$(dossier, 1) <> "\" Then dossier = dossier & "\"
        'copie impossible:dossier source et destination identique
        If LCase$(Chemin) = LCase$(dossier) Then
            MsgBox "Impossible de copier les fichiers. Le dossier de destination est identique au dossier souce.", vbInformation, "Avertissement"
            Exit Sub
        End If
        'demande si ecrasement des fichiers existant ou non ou annulation de la copie
        reponse = MsgBox("Vous allez copier des fichiers." & vbCrLf & vbCrLf & "Appuyez sur OUI pour écraser les fichiers si ils existent déja." & vbCrLf & _
        "Appuyez sur NON pour copier les fichiers sans écraser ceux déja existant." & vbCrLf & _
        "Appuyez sur ANNULER pour ne rien copier", vbQuestion + vbYesNoCancel + vbDefaultButton3, "Avertissement:")
        If reponse = vbCancel Then Unload Me 'pas de copie
        ecrasement = IIf(reponse = vbYes, False, True) 'ecrasement ou non
        'copie des fichiers
        For I = 0 To UBound(tab_Fichiers)
            If tab_Fichiers(I) <> "" Then
                retour = CopyFile(Chemin & tab_Fichiers(I), dossier & tab_Fichiers(I), ecrasement)
            End If
        Next I
        'sortie
        Unload Me
        
    Case 1 'QUITTER
        Unload Me
        
    Case 2 'NOUVEAU DOSSIER
        'nouveau dossier?
        If txtDossier.Text = "" Then
            MsgBox "Saisissez un nom pour le nouveau dossier.", vbInformation, "Information"
            Exit Sub
        End If
        'le nouveau dossier existe t il deja?
        Dim nouveau_rep$
        Dim nb_rep%
        For nb_rep = 0 To Dir1.ListCount - 1
            nouveau_rep = LCase$(NomDossier(Dir1.List(nb_rep)))
            If LCase$(Trim$(txtDossier.Text)) = LCase$(nouveau_rep) Then
                MsgBox "Impossible de créer le nouveau dossier. Celui-ci existe déja.", vbInformation, "Dossier existant..."
                Exit Sub
            End If
        Next nb_rep
        'creation du nouveau dossier
        nouveau_rep = Dir1.Path
        If Right$(nouveau_rep, 1) <> "\" Then nouveau_rep = nouveau_rep & "\"
        nouveau_rep = nouveau_rep & Trim$(txtDossier.Text)
        If MsgBox("Êtes-vous sûr(e) de vouloir créer le nouveau dossier: " & Trim$(txtDossier.Text) & vbCrLf & "dans le dossier:  " & Dir1.Path, vbQuestion + vbYesNo + vbDefaultButton1, "Nouveau dossier") = vbNo Then Exit Sub
        MkDir nouveau_rep
        Dir1.Refresh
        For nb_rep = 0 To Dir1.ListCount - 1
            If LCase$(Dir1.List(nb_rep)) = LCase$(nouveau_rep) Then Dir1.Path = Dir1.List(nb_rep): Exit For
        Next nb_rep
End Select
'
End Sub

Private Function Verif_Dossier(chemin_dossier As String) As Boolean
'permet de savoir si le repertoire voulu existe
'exemple d'appel: ok=Verif_Dossier("c:\aaaaaaaa\bbbbb")
'
Dim nom As String
'
If (nom = Dir(chemin_dossier, vbDirectory)) = vbEmpty Then
    Verif_Dossier = True
Else
    Verif_Dossier = False
End If
'
End Function

Private Sub Dir1_Change()
txtDossier.Text = NomDossier(Dir1.List(Dir1.ListIndex))
End Sub

Private Sub Dir1_Click()
txtDossier.Text = NomDossier(Dir1.List(Dir1.ListIndex))
End Sub


Private Sub Drive1_Change()
On Error GoTo annulation
Dir1.Path = Drive1.Drive
txtDossier.Text = NomDossier(Dir1.List(Dir1.ListIndex))
Exit Sub
'erreur
annulation:
MsgBox Err.Description, vbCritical, "ERREUR..."
Drive1.Drive = Dir1.Path
End Sub


Private Sub Form_Load()
'fenetre de copie de fichier  à integrer dans votre application
'exemple d'appel de la fenetre. celle ci s'appelle frmCopierDossier
'soit une fenetre appelee form1. a partir de celle-ci
'en appuyant sur un bouton appele Command1 de cette form
'vous affichez cette fenetre de copie de fichier
'ayant au prealable selectionne les fichiers a copier
'a partir d'une liste de fichier (controle FileListBox) appelee File1 de la form1
'
'******DEBUT DU CODE
'Private Sub Command1_Click()
'si au moins 1 fichier est selectionne dans la liste des fichiers
'Dim I%
'For I = 0 To File1.ListCount - 1
'    If File1.Selected(I) = True Then GoTo suite
'Next I
'exit sub
'suite:
'Load frmCopierDossier 'charge la feuille en memoire
'With frmCopierDossier
    'position de la fenetre
    '.Top = X 'mettez ici la position en hauteur X de la fenetre
    '.Left = Y 'mettez ici la position gauche Y de la fenetre
    '.Show vbModal 'affiche la fenetre
    'pour la copie des fichiers voir la procedure "Boutons_Click(index as integer)"
'End With
'end sub
'voila, rien de plus simple.maintenant il faut affecter la bonne zone de liste de fichiers
'a la variable objet qui suit.Ce code doit rester sur la form frmCopierDossier
'dans cette procedure form_load()
Set zone_fichiers = Form1.File1 'nom de la form.nom de la FileListBox contenant la liste des fichiers
'********FIN DU CODE
'
'NE PAS CHANGER
Dim Z%
Z = 0
ReDim tab_Fichiers(Z)
Chemin = zone_fichiers.Path 'on memorise le chemin d'origine
If Right$(Chemin, 1) <> "\" Then Chemin = Chemin & "\" 'ajout d'un \ si sur la racine
Dim I%
For I = 0 To zone_fichiers.ListCount - 1
    If zone_fichiers.Selected(I) = True Then
        tab_Fichiers(Z) = zone_fichiers.List(I)
        Z = Z + 1
        ReDim Preserve tab_Fichiers(Z)
    End If
Next I
'on a remplit le tableau tab_Fichiers pour qu'il contienne le nom des fichiers selectionnes
'
txtDossier.Text = NomDossier(Dir1.List(Dir1.ListIndex))
'
End Sub



Private Function NomDossier(Chemin As String) As String
NomDossier = ""
'
Dim Z%
For Z = Len(Chemin) To 1 Step -1
    If Mid$(Chemin, Z, 1) = "\" Then
        NomDossier = Right$(Chemin, Len(Chemin) - Z)
        Exit Function
    End If
Next Z
'
End Function



Private Function CheminDossier(Chemin As String) As String
'
CheminDossier = ""
'
Dim Z%
For Z = Len(Chemin) To 1 Step -1
    If Mid$(Chemin, Z, 1) = "\" Then
        CheminDossier = Left$(Chemin, Z)
        Exit Function
    End If
Next Z
'
End Function

Private Sub Form_Unload(Cancel As Integer)
Set zone_fichiers = Nothing
End Sub




'je sais qu'il manque une référence à l'objet dataobjectfiles telle que celle-ci doit être:
'set fichier = new Dataobjectfiles
'
'mais, je ne trouve pas l'objet dans la liste des références possibles sur mon pc.
'
'alors, merci si vous trouvez la solution...