Formulaire couper/coller un dossier du Disque Dur

Bonsoir amis d'excel.

Depuis cet apres midi je bloque sur un truc qui me semble idiot à faire, mais je ne sais pas pourquoi, aucun de mes test fonctionne.

J'ai trouver sur google, un formulaire, (ci-joint) qui est super d'ailleur et qui permet de selectionner un dossier source, de selectionner un ou plusieurs fichiers (couper), puis de selectionner un dossier cible et de coller les fichiers.

Je souhaite changer la formule, pour que ce soit le dossier selectionné qui est coupé, et coller dans le dossier cible.

J'ai trouver un code qui me semble interessant pour ce que je veux non? si interessant, OU le placer dans ce formulaire.

Je suis completement a 'l'ouest dans mes recherches. aidez moi svpppppppp

Dim fso As Object

Set fso = CreateObject("Scripting.FileSystemObject")
fso.copyfolder strEmplacementCopier, strEmplacmentColler

Hello.

Chez moi le fichier ne fonctionne pas (sûrement une référence manquante, ou une mauvaise manip de ma part)

Peut importe, je pense que la modification doit être faite dans cette partie de code:

For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                source = Label1.Caption & "\" & ListBox1.List(i)
                destin = Label2.Caption & "\" & ListBox1.List(i)
                If oFSO.FileExists(source) Then
                    oFSO.MoveFile source, destin
                End If
            End If
        Next i

qui est situé dans CommandButton3_Click

 oFSO.MoveFile source, destin

>>

oFSO.CopyFolder source, destin

où "source" sera le répertoire de ton dossier, donc sûrement:

source =  Label1.Caption & "\"

De plus, il faudra changer le test:

If oFSO.FileExists(source)

>>

If oFSO.FolderExists(source) 'je sais pas si cette fonction existe :D

Voilà un code qui fonctionne (j'ai fait qu'un test mais chez moi c'est ok)

et joint le fichier. Il suffit de sélectionner le dossier source, le dossier d'arrivée, et de cliquer sur le bouton (la liste déroulante ne sers plus à rien)

Private Sub CommandButton3_Click()
Dim i As Long
Dim source As String, destin As String, message As String
Dim oFSO As Scripting.FileSystemObject
Dim Rep As Integer

message = "Etes-vous sur(e) de vouloir déplacer le dossier : " & vbLf & vbLf & Label1.Caption & vbLf & vbLf & "vers : " & vbLf & vbLf & Label2.Caption
Rep = MsgBox(message, vbYesNo + vbQuestion, "Confirmation")
If Rep = vbYes Then

    Set oFSO = New Scripting.FileSystemObject
                source = Label1.Caption
                destin = Label2.Caption
                If oFSO.FolderExists(source) Then
                    oFSO.CopyFolder source, destin & "\" & Right(source, Len(source) - InStrRev(source, "\"))
                End If
    'ElementsRepertoire Label1.Caption
    MsgBox "Déplacement(s) effectué(s).", vbOKOnly + vbInformation, "Fin de traitement"
Else
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
End If
End Sub

Salut, ton code fonctionne a merveille merci beaucoup.

Par contre il manque juste un petit truc.

Le dossier est present dans les deux dossiers, comment faire un COUPER coller et non un copier coller?

merci bcp

Remplace

oFSO.CopyFolder source, destin & "\" & Right(source, Len(source) - InStrRev(source, "\"))

par

oFSO.MoveFolder source, destin & "\" & Right(source, Len(source) - InStrRev(source, "\"))

Au top merci infiniment !!

par contre j'ai tenté de mettre l'userform dans mon classeur perso.

J'ai donc cliquer droit sur userform1, j'ai fait exporter puis je l'ai renommer en userform3

je vais dans mon classeur perso, j'importe l'userform3.

je creer un bouton avec le code suivant :

Sub deplacerdossier()
userform3.Show
End Sub

et ca ne fonctionne pas. j'oublie un truc?

Oui c'est normal. Vas dans le code VBA du Userform, choisi la commande 'remplacer' du menu "edition" et remplace:

Userform1 par Userform3 (et ce pour toutes les occurences). Après tout devrait fonctionner.

je n'y arrive pas. j'en peux plus lol

je vais dans ton classeur que tu as joint.

je renomme userform1 en userform3

je l'exporte.

Je l'importe dans mon classeur perso.

je fait le code suivant dans un bouton

    Sub deplacerdossier()
    userform3.Show
    End Sub

et j'ai une erreur compilation

type defini par l'utilisateur non defini

en jaune j'ai Private Sub CommandButton3_Click()

en bleu j'ai oFSO As Scripting.FileSystemObject


voici le fichier tel que j'en ai besoin, je ne comprend pas il n'y à même pas de macro, comment fonctionne son bouton?

Bonjour

Pourquoi tu fournis un fichier qui fonctionne ?

Pour info : le code du bouton est dans le module de la feuille (clic droit sur l'onglet de la feuille --> Visualiser le code)

Il faut fournir ton fichier en défaut

voici mon classeur perso.

j'ai donc importer l'userform, creer un bouton avec la macro qui appel le formulaire, et ca ne fonctionne pas

au secours lol

22classeur1.xlsm (23.33 Ko)

Bonjour

2 solutions

1ère solution : Dans les références il faut activer "Microsoft Scripting Runtime"

Seconde solution : Modifier la macro

Private Sub CommandButton3_Click()
Dim i As Long
Dim source As String, destin As String, message As String
  'Dim oFSO As Scripting.FileSystemObject
Dim oFSO As Object
Dim Rep As Integer

  message = "Etes-vous sur(e) de vouloir déplacer le dossier : " & vbLf & vbLf & Label1.Caption & vbLf & vbLf & "vers : " & vbLf & vbLf & Label2.Caption
  Rep = MsgBox(message, vbYesNo + vbQuestion, "Confirmation")
  If Rep = vbYes Then

    'Set oFSO = New Scripting.FileSystemObject
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    source = Label1.Caption
    destin = Label2.Caption
    If oFSO.FolderExists(source) Then
      oFSO.MoveFolder source, destin & "\" & Right(source, Len(source) - InStrRev(source, "\"))
    End If
    'ElementsRepertoire Label1.Caption
    MsgBox "Déplacement(s) effectué(s).", vbOKOnly + vbInformation, "Fin de traitement"
  Else
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
  End If
End Sub

magnifique merciiiii encore banzai sujet resolu !!

Derniere questions, quand je clique sur choix du repertoire source, j'aimerais qu'il m'amene directement dans G:drop\JN\Devis

et quand je clique sur choix du repertoire destination j'aimerai qu'il m'amene directement dans G:drop\JN\Facture

c'est possible?

Bonjour

Il faut modifier 2 macros

Pour la source

Private Sub CommandButton1_Click()
Dim objShell As Object, objFolder As Object

  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&, "G:drop\JN\Devis")

  If objFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
    End
  Else
    ElementsRepertoire objFolder.ParentFolder.ParseName(objFolder.Title).Path
  End If
End Sub

Pour la destination

Private Sub CommandButton2_Click()
Dim objShell As Object, objFolder As Object

  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&, "G:drop\JN\Facture")

  If objFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
  Else
    Label2.Caption = objFolder.ParentFolder.ParseName(objFolder.Title).Path
  End If
End Sub

Attention : Ces répertoires seront considérés comme la racine de ton disque, tu ne pourras pas remonter au dessus

super merciiiiii ca fonctionne nickel

Rechercher des sujets similaires à "formulaire couper coller dossier disque dur"