Copier des fichiers dans un répertoire à créer au nom du user
Résolu/Fermé
A voir également:
- Copier des fichiers dans un répertoire à créer au nom du user
- Créer un compte gmail - Guide
- Créer un compte google - Guide
- Créer un groupe whatsapp - Guide
- Créer un compte instagram - Guide
- Créer un lien pour partager des photos - Guide
5 réponses
lermite222
Messages postés
8702
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
18 oct. 2013 à 03:02
18 oct. 2013 à 03:02
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+
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 !!!
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
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
lermite222
Messages postés
8702
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
18 oct. 2013 à 12:21
18 oct. 2013 à 12:21
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
Un Nouveau module..
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
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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.
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.
