Création de dossier en automatique

[gildas lechat]

Bonjour à tous,

Voici un nouveau problème à vous soumettre.
J'ai une série de dossier à créer avec un contenue identique.
Le nombre de dossier est important et surtout la création de dossier récurente
J'aimerai pouvoir créer les dossiers comme expliqué dans le fichier joint.
Merci d'avance de votre aide
Gildas

 

[mromain]

Re : Création de dossier en automatique

bonjour gildas,

voici un essai (pas testé)

Private Sub CommandButton1_Click()
Dim nouveauDossier As String

'si ce n'est pas un chiffre qui a été saisi dans le champ, quitter la macro
If Not IsNumeric(TextBox1.Text) Then Exit Sub

'créer un dossier "Origine" (ThisWorkbook.Path) + "textbox"
nouveauDossier = ThisWorkbook.Path & "\" & CInt(TextBox1.Text)
CreateObject("Scripting.FileSystemObject").CreateFolder nouveauDossier

'copier le fichier "a-original1.XLS"
CreateObject("Scripting.FileSystemObject").CopyFile ThisWorkbook.Path & "\a-original1.XLS", nouveauDossier & "\a-" & CInt(TextBox1.Text) & ".xls"

End Sub

Private Sub CommandButton2_Click()
Dim nouveauDossier As String, i As Integer

'si ce ne sont pas des chiffres qui ont été saisis dans les champ, quitter la macro
If Not IsNumeric(TextBox2.Text) Then Exit Sub
If Not IsNumeric(TextBox3.Text) Then Exit Sub

For i = CInt(TextBox2.Text) To CInt(TextBox3.Text)

    'créer un dossier "Origine" (ThisWorkbook.Path) + i
    nouveauDossier = ThisWorkbook.Path & "\" & i
    CreateObject("Scripting.FileSystemObject").CreateFolder nouveauDossier
    
    'copier le fichier "a-original1.XLS"
    CreateObject("Scripting.FileSystemObject").CopyFile ThisWorkbook.Path & "\a-original1.XLS", nouveauDossier & "\a-" & i & ".xls"

Next i

End Sub

a+

 

[gildas lechat]

Re : Création de dossier en automatique

Bonjour tout le monde,

J'ai inséré le code ci dessus dans la macro.
le code ci dessus semble comporter des erreurs ou je l'ai mal inséré...
je joint les fichiers zipper.
(les explications de l'action sont joint au premier message)
Si quelqu'un peu m'aider..😕

Merci
Gildas

 

[mromain]

Re : Création de dossier en automatique

bonjour gildas,


tu as oublié d'enlever la protection sur le projet VBA de ton classeur..
Sinon, vu la "structure" des tes fichier-dossier, essaye avec ces modifs :

Private Sub CommandButton1_Click()
Dim nouveauDossier As String

'si ce n'est pas un chiffre qui a été saisi dans le champ, quitter la macro
If Not IsNumeric(TextBox1.Text) Then Exit Sub

'créer un dossier "Origine" (ThisWorkbook.Path) + "textbox"
nouveauDossier = ThisWorkbook.Path & "\" & CInt(TextBox1.Text)
CreateObject("Scripting.FileSystemObject").CreateFolder nouveauDossier

'copier le fichier "a-original1.XLS"
CreateObject("Scripting.FileSystemObject").CopyFile ThisWorkbook.Path & "[B][COLOR=Red]\Original[/COLOR][/B]\a-original1.XLS", nouveauDossier & "\a-" & CInt(TextBox1.Text) & ".xls"

End Sub



Private Sub CommandButton2_Click()
Dim nouveauDossier As String, i As Integer

'si ce ne sont pas des chiffres qui ont été saisis dans les champ, quitter la macro
If Not IsNumeric(TextBox2.Text) Then Exit Sub
If Not IsNumeric(TextBox3.Text) Then Exit Sub

For i = CInt(TextBox2.Text) To CInt(TextBox3.Text)

    'créer un dossier "Origine" (ThisWorkbook.Path) + i
    nouveauDossier = ThisWorkbook.Path & "\" & i
    CreateObject("Scripting.FileSystemObject").CreateFolder nouveauDossier
    
    'copier le fichier "a-original1.XLS"
    CreateObject("Scripting.FileSystemObject").CopyFile ThisWorkbook.Path & "[B][COLOR=Red]\Original[/COLOR][/B]\a-original1.XLS", nouveauDossier & "\a-" & i & ".xls"

Next i

End Sub

a+

 

[gildas lechat]

Re : Création de dossier en automatique

Bonjour à tous,
Bonjour mromain

Le mot de passe est 123 pour accéder au macro..sorry
il y a un mieux, je pense avoir réussi a créer un dossier, mais vide (sans copie du fichier .xls )

J'ai copié le nouveau code. le bloquage de la macro est toujours présente😕

Cela peut peu être t'aider, le chemin source des différents dossier est la suivante 😀:\info travail\Macro\essai

Je joint la macro modifier avec ton code
@+
gildas

 

[mromain]

Re : Création de dossier en automatique

re,


tu as un soucis sur une ligne (tu avais du mal copier le code)
remplacer

nouveauDossier = ThisWorkbook.Path & " \ " & CInt(TextBox1.Text)

par

nouveauDossier = ThisWorkbook.Path & "\" & CInt(TextBox1.Text)

(enlever les espace autour du \)


a+

 

[gildas lechat]

Re : Création de dossier en automatique

Hello,

le prb est toujours présent
gildas

 

[mromain]

Re : Création de dossier en automatique

Hello,

le prb est toujours présent
gildas

bizarre, chez moi ça fonctionne en faisant la modif indiquée précédemment...

je ne vois pas trop.


a+

 

[gildas lechat]

Re : Création de dossier en automatique

Hello,

j'ai un message d'erreur du type :
erreur 6 :dépassement de capacité
l'erreur est situé sur la ligne (après activation du bouton 1) :

nouveauDossier = ThisWorkbook.Path & "\" & CInt(TextBox1.Text)

si quelqu'un peux m'aider..
merci d'avance
Gildas

 

[tototiti2008]

Re : Création de dossier en automatique

Bonjour à tous,

je n'ai pas tout suivi de la discussion mais vu le message d'erreur, comme ta ligne de code contient Cint :
si ton nombre dépasse 65536, c'est trop grand pour un Integer, il faut un Long

bref, essaye de remplacer CInt par CLng

 

[gildas lechat]

Re : Création de dossier en automatique

Merci tototiti 2008

J'avance d'une ligne
le nouveau code erreur est le suivant:
erreur 76 : "chemin d'accès introuvable" sur la ligne suivante:
CreateObject("Scripting.FileSystemObject").CreateFolder nouveauDossier

Le chemin source ou le nouveau dossier doit être créer est le suivant: D:\info travail\Macro\essai

Si vous pouvez m'aider
merci
Gildas

 

[tototiti2008]

Re : Création de dossier en automatique

Re,

et que vaut la variable nouveaudossier quand ça plante ? (utilise un Espion)

 

[gildas lechat]

Re : Création de dossier en automatique

Bonsoir à tous,

OK ça fonctionne por la création de 1 fichier.

La 2eme partie consite a créer de la même façon des fichier entre 2 nombres;
Exemple : de 50000 a 50005:
Création du fichier 50000, 50001, 50002... 500005.
j'ai un autre message d'erreur du type:
erreur 6 :'dépassement de capacité' sur la ligne en rouge ;


Private Sub CommandButton2_Click()
dossierSource = "D:\info travail\Macro\essai"
fichierSource = "D:\info travail\Macro\essai\Original"
Dim nouveauDossier As String, i As Integer

'si ce ne sont pas des chiffres qui ont été saisis dans les champ, quitter la macro
If Not IsNumeric(TextBox2.Text) Then
MsgBox "erreur de saisi ou pas de référence"
Exit Sub
End If

If Not IsNumeric(TextBox3.Text) Then
MsgBox "erreur de saisi ou pas de référence"
Exit Sub
End If

For i = CLng(TextBox2.Text) To CLng(TextBox3.Text)

'créer un dossier "Origine" (ThisWorkbook.Path) + i
nouveauDossier = dossierSource & "\" & i
CreateObject("Scripting.FileSystemObject").CreateFolder nouveauDossier

'copier le fichier "a-original1.XLS"
CreateObject("Scripting.FileSystemObject").CopyFile fichierSource & "\a-original1.XLS", nouveauDossier & "\a-" & i & ".xls"

Next i

End Sub