FileCopy avec nom de dossier et document variable

Bonjour à tous
Voici le problème que je rencontre.

Dans un premier temps je vais rechercher à l'aide de la méthode "GetOpenFileName" un document dont le chemin d'accès sera stocké dans un label.

Code:

---

1 2 3 4

Dim QuelFichier QuelFichier = Application.GetOpenFilename() If QuelFichier <> False Then Label_chemin_fichier_a_enregistrer.Caption = QuelFichier

---

Ensuite je fais apparaître un message box pour me demander si je souhaite enregistrer ce document.
Si je clique sur "oui" alors:

-La procédure va dans un premier temps créer dossier dont le nom était renseigné précédemment dans une combobox.

Code:

---

1 2 3 4 5

Select Case MsgBox("Confirmer l'enregistrement du document, vbYesNo, "Rattachement d'un document") Case vbYes     MkDir "F:\Base de donné REX\Base document\" & frm_fiche_creation_rex.ComboBox_choixRF.Value

---

C'est ensuite que les choses se compliquent

Je voudrais que le document, dont le chemin est stocké dans le label soit copier collé dans le dossier qui vient d'être crée.

J'ai essayé avec la méthode "FilCopy" mais je n'arrive pas y insérer les variables.

Pouvez-vous m'aider?
Merci

Bonjour,

J'utilise cette macro :

Code:

---

1 2 3 4 5 6 7 8 9 10

Sub CopieFichier(Source As String, Destination As String)   Dim Fso As Object   Set Fso = CreateObject("Scripting.FileSystemObject") Fso.CopyFile Source, Destination Set Fso = Nothing   End Sub

---

Où Source et destination correspondent chaque fois aux Répertoire & "\" & Nom du fichier.

Cordialement.

Bonjour.

Citation:

---

Envoyé par Eric KERGRESSE

Où Source et destination correspondent chaque fois aux Répertoire & "\" & Nom du fichier.

---

Idem avec FileCopy source, destination …

Merci pour vos réponses : )

Du coup comment écrire la synthaxe pour coder "source" et "destination"?
en reprenant les informations stockées?

Merci

Une illustration à adapter à partir de ma proposition

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Private Sub CommandButton1_Click()     Dim QuelFichier As Variant Dim RepertoireFichier As String Dim NomDuFichier As String Dim NouveauRepertoire As String     QuelFichier = Application.GetOpenFilename() If QuelFichier <> False Then Label_chemin_fichier_a_enregistrer.Caption = QuelFichier ' Nom du fichier avec son répertoire RepertoireFichier = CurDir ' Nom du répertoire NomDuFichier = Dir(QuelFichier) ' Nom du fichier End If   NouveauRepertoire = CurDir & "\Essai V1" ' A adpater à votre cas MkDir NouveauRepertoire CopieFichier Label_chemin_fichier_a_enregistrer, NouveauRepertoire & "\" & NomDuFichier     End Sub

---

Cordialement

Bonsoir

J'ai essayé de reprendre votre code en l'adaptant mais j'ai du mal à le finaliser.... : (

Au début du code aucun problème je comprend..
Il nous permet d'ouvrir l'arborescence windows pour choisir un document.
Lorsqu'on ouvre ce dernier, son chemin d'accès ce stock dans un label.

C'est ensuite que j'ai du mal à comprendre la logique pour l'adapter.

Sachant que précédemment dans un formulaire j'ai une combobox avec le nom du nouveau dossier à créer.-->

Code:

---

frm_fiche_creation_rex.ComboBox_choixRF

---

C'est la valeur qui est contenu dans cette combobox que je souhaite utiliser comme nom de nouveau dossier.

Pour l'exemple je souhaiterai enregistrer le document "test" venant d'être ouvert via GetOpenFilename dans le nouveau dossier qui se trouve dans le repertoire C:\Users.

La finalité serai donc que mon document "test" s'enregistre dans le dossier "nouveau" (valeur issu de ma textbox).

C:\Users\nouveau\test


Ci dessous le code fournit au post d'avant que j'ai essayé d'adapter.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29

Private Sub CommandButton_parcourir_Click()     Dim QuelFichier 'chemin du document à rattacher Dim RepertoireFichier As String Dim NomDuFichier As String Dim NouveauRepertoire As String     'On va ouvrir l'arborescence windows pour rechercher un document à rattacher   QuelFichier = Application.GetOpenFilename()   If QuelFichier <> False Then 'Lorsque l'on clique sur le nom du document à rattacher, le nom de son chemin est affiché dans le label     Label_chemin_fichier_a_enregistrer.Caption = QuelFichier ' Nom du fichier avec son répertoire RepertoireFichier = CurDir ' Nom du répertoire NomDuFichier = Dir(QuelFichier) ' Nom du fichier   End If   NouveauRepertoire = CurDir & "\frm_fiche_creation_rex.ComboBox_choixRF" ' A adpater à votre cas MkDir "F:\Base de donné REX\Base document\" & NouveauRepertoire FileCopy Label_chemin_fichier_a_enregistrer, NouveauRepertoire & "\" & NomDuFichier       End Sub

---

Merci de votre aide : )

Bonjour,

Il faudrait modifier les lignes suivantes dans votre code :

Code:

---

1 2 3 4

NouveauRepertoire = RepertoireFichier & "\" & ComboBox_choixRF MkDir NouveauRepertoire FileCopy Label_chemin_fichier_a_enregistrer, NouveauRepertoire & "\" & NomDuFichier

---

Sachant que ComboBox_choixRF ne contient que le nom du nouveau sous-répertoire que vous souhaitez créer.

Sinon, le fichier joint contient le code ci-dessous pour le Userform1 :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67

Option Explicit   Private QuelFichier As Variant ' Chemin + nom du fichier du document à rattacher Private RepertoireFichier As String ' Chemin du document à rattacher Private NomDuFichier As String ' Document à rattacher   Private Sub CommandButton_parcourir_Click()   QuelFichier = Application.GetOpenFilename()   If QuelFichier <> False Then   Label_chemin_fichier_a_enregistrer.Caption = QuelFichier ' Chemin + Nom du fichier choisi RepertoireFichier = CurDir ' Nom du répertoire de stockage actuel NomDuFichier = Dir(QuelFichier) ' Nom du fichier à transférer TextBox_parcourir = NomDuFichier   If TextBox_parcourir = ActiveWorkbook.Name Then MsgBox "Vous ne pouvez pas copier et transférer le fichier de travail actuel dans un nouveau répertoire !", vbCritical, "Choix du fichier à transférer" Label_chemin_fichier_a_enregistrer.Caption = "Nom du fichier à transférer" RepertoireFichier = "" TextBox_parcourir = "" End If End If   End Sub   Private Sub TextBox_choixRF_Change()   If VerificationExistenceRepertoire(CurDir & "\" & TextBox_choixRF) = True Then MsgBox "Le répertoire que vous tentez de créer est existant !", vbCritical, "Création du répertoire " & TextBox_choixRF TextBox_choixRF = "" End If   End Sub   Private Sub BoutonValider_Click()   If TextBox_choixRF = "" Then MsgBox "Vous devez définir un nouveau répertoire !", vbCritical, "Création du nouveau répertoire" Exit Sub End If   If TextBox_parcourir = "" Then MsgBox "Vous devez choisir un fichier !", vbCritical, "Copie et transfert d'un fichier" Exit Sub End If   If VerificationExistenceRepertoire(CurDir & "\" & TextBox_choixRF) = False And TextBox_parcourir <> "" Then   MkDir RepertoireFichier & "\" & TextBox_choixRF FileCopy Label_chemin_fichier_a_enregistrer, RepertoireFichier & "\" & TextBox_choixRF & "\" & NomDuFichier Continuer = True Unload UserForm1 Else MsgBox "Le répertoire que vous tentez de créer est existant !", vbCritical, "Création du répertoire " & TextBox_choixRF TextBox_choixRF = "" End If       End Sub   Private Sub BoutonAbandonner_Click() Continuer = False Unload UserForm1 End Sub

---

Le fichier contient dans le module 1, une fonction permettant de vérifier la présence ou non du répertoire à créer :

Code:

---

1 2 3 4 5 6 7 8 9

Function VerificationExistenceRepertoire(NomDuRepertoire)   Dim Fso As Object   Set Fso = CreateObject("Scripting.FileSystemObject") VerificationExistenceRepertoire = Fso.FolderExists(NomDuRepertoire) Set Fso = Nothing   End Function

---

Il vous suffit de faire l'essai déjà avec ce fichier et de remplacer le textbox avec votre combobox.

Cordialement.

Merci pour ton développement : )

J'ai adapté ton exemple à mon problème et celà fonctionne parfaitement : )
Je vais maintenant essayer de le personnaliser.

Je te remercie encore pour le temps que tu as consacré : )