Copier des fichiers dans un répertoire à créer au nom du user

[Résolu/Fermé]
Signaler
-
 besdu06 -
Bonjour,

Je voudrais copier d'un répertoire des fichiers ayant l'extension .pdf dans un autre répertoire qui sera préalablement crée et dont le nom devra être le user de l'ordinateur (fonction "username")

Pourriez vous, s'il vous plait me donner le code vba nécessaire à ces actions là? En effet, j'arrive à faire une action après l'autre indépendamment mais pas simultanément.

Je vous remercie par avance !!

5 réponses

Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 173
Bonjour,
Et bien montre-nous les actions séparées que tu a faites et nous t'aiderons pour optimiser et lier les procédures.
A+
Bonjour lermite222,

voici le code que j'ai (là c'est pour les fchiers .udo):

Private Sub CmdSvgdeUDO_Click()
Dim user As String
Dim FSys
Dim Source, Destination As String

user = Environ("username")
Set FSys = CreateObject("Scripting.FileSystemObject")

Source = "X:\...\*.udo"
Destination = "S:\...\BO"

'Copie d'un fichier .UDO
FSys.CopyFile Source, Destination, True
MsgBox "Le fichier a bien été copié", vbInformation

' Récupère les fichiers .UDO dans le disque X : à destination du serveur Q:

End Sub

L'objectif ici c'est de récupérer les fichiers .udo, et de les copier dans un répertoire qui devra se créer en même temps avec le nom du user. Ce répertoire devra se trouver dans le répertoire "BO".

Voici le code pour la création du répertoire:


Private Sub CmdSvgdeUDO_Click()
Dim user As String

'Création du répertoire user dans le répertoire BO
Repertoire = "S:\..."
If Dir(Repertoire, vbDirectory) = "" Then MkDir Repertoire & user

Je vous remercie !!!
Personne ne se propose?

Pour la création du répertoire j'ai mis:

Private Sub CmdSvgdeUDO_Click()
Dim Chemin As String

Chemin = "S:....."
If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin
MsgBox "Répertoire créé.", vbInformation

End Sub

Je lance la commande Access, j'ai bien le message comme quoi le répertoire est bien cré, mais quand je vais vérifier, il n' y a rien !!

Qu'est ce qu'il pourrai manquer à ce code pour créer déjà mon répertoire avant de le renommer avec mon user ?

Merci
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 173
C'est la limite de la méthode Dir, il faut d'abor sélectionner l'unité avant de créer le répertoire avec
ChDrive "S:" 
Mais il y a plus simple, l'API crée le répertoire si n'existe pas mais aussi les répertoires intermédiaire. Si existe ne fait rien.
Un Nouveau module..
Option Explicit
Public Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Sub CréeRep(Rep As String)
MakeSureDirectoryPathExists Rep
End Sub

Sub TestRep()
CréeRep "S:\tester2\"
End Sub
FInalement j'y suis arrivé à créer le répertoire nommé du nom du user comme ci dessous:

Private Sub CmdSvgdeUDO_Click()
Dim FSys
Dim u As String
Dim Source, Destination As String

u = Environ("username")
Set FSys = CreateObject("Scripting.FileSystemObject")

Source = "X:\My Business Objects Documents\Universes\*.udo"
Destination = "S:\...\BO"

FSys.CreateFolder "S:\...\BO\" & u
FSys.CopyFile Source, Destination, True
Set FSys = Nothing
MsgBox "Répertoire bien crée !", vbInformation

End Sub

Par contre, dans le même répertoire "BO" je me retrouve avec les fichiers .UDO ET le répertoire "User" créé indépendamment. Ce que je voudrai c'est que les fichiers .UDO se retrouvent DANS le répertoire "User" créé.

...et ca je ne sais pas faire...vous auriez une petite idée?

Je vous remercie
J'ai trouvé la solution, elle servira peut etre pour d'autres internautes débutants en VBA :)

Private Sub CmdSvgdeUDO_Click()
Dim FSys
Dim u As String
Dim Source, Destination As String

u = Environ("username")
Set FSys = CreateObject("Scripting.FileSystemObject")

Source = "X:\My Business Objects Documents\Universes\*.udo"
Destination = "S:\...\BO\" & u

FSys.CreateFolder "S:\...\BO\" & u
FSys.CopyFile Source, Destination, True
Set FSys = Nothing
MsgBox "Répertoire et fichier bien crée !", vbInformation

End Sub

Ce code permet donc de copier les fichiers .UDO dans le répertoire "user" crée en même temps que la copie des fichiers.