Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

enregistrement avec creation de dossier

18 réponses
Avatar
tinou
Bonjour à vous,

j'ai des bouts de code, mais j'aimerais aller plus loin... !

Imaginons que j'ai 2 dossiers :
L:/debut
L:/fin

Dans le premier dossier, j'ai 1 dossier Toto, avec 1 fichier Excel :
L:\debut\Toto\fichier1.xls
L:\fin

Le but de la macro, c'est que quand je l'execute à partir du fichier1.xls,
le fichier s'enregistre en texte separer par des tabulations dans le dossier
Toto du dossier fin...!
L:\fin\Toto\fichier1.txt
Donc la macro aura créee un nouveau dossier Toto.
En resumer,
L:\debut\Toto\fichier1.xls devient L:\fin\Toto\fichier1.txt
donc pour generaliser,
un fichier ouvert ayant comme adresse : L:\debut\*\§\£\#.xls
sera enregistrter dans L:\fin\*\§\£\#.txt (separateur tabs)

Voila, je vous remercie d'avance pour votre aide

Max

10 réponses

1 2
Avatar
Norvi
Bonjour,

Sub Creer_Dossier_Puis_Enregistrer()
Dim Mon_Dossier, Chemin_A_Creer As String
On Error Resume Next
Chemin_A_Creer = "c:Yooouooouou"
Mon_Dossier = GetAttr(Chemin_A_Creer) And 0
If Err.Number <> 0 Then
MkDir Chemin_A_Creer
End If
ActiveWorkbook.SaveAs Filename:=Chemin_A_Creer & "XXXXX.txt",
FileFormat:=xlText
End Sub

Bonne journée,

N.
Avatar
tinou
?
C'est gentil pour ta reponse, mais c'est pas trop ca...
ton code me creer un dossier et m'enregistre le fichier avec des noms que tu
as defini..., moi le but, c'est que les noms des dossiers, sous dossiers et
fichiers varient SELON le fichier d'origine !!!

J'aimerais garder un "parallele" ordonner entre R:debut* et R:fin*

Merci encore
Avatar
Norvi
Tinou,

Pas de problème, mais alors donne moi les critères qui te permette de
savoir ou, comment et sous quel nom enregistrer ton fichier.
Chemin_A_Creer peut être modifier par ce que tu veux, idem pour le nom
du fichier.
Avatar
tinou
c'est gentil de m'aider...

on va parler avec des exemples, se sera plus claire.

Dans mon repertoire L:debut j'ai des dossiers et des sous dossiers,
L:debutbananepomme
L:debutoiseauaigle
L:debutcoincoincuicuilalatutu

Dans mon repertoir L:fin j'ai : soit rien, soit des dossiers et des sous
dossiers
L:fin
L:finbananepomme
L:finoiseau
L:fincoincoin

--------------------------------------------------------
j'ouvre mon fichier excel :
L:debutbananepommekiki.xls

je lance ma (future) macro, je me retrouve avec :
L:finbananepommekiki.txt
elle a donc enregistré le fichier kiki.xls en kiki.txt dans L:fin
**il y a que le dossier FIN qui a changé**
--------------------------------------------------------

j'ouvre mon fichier excel :
L:debutoiseauaigle123.xls

je lance la macro, je me retrouve avec :
L:finoiseauaigle123.xls
elle a donc créee un dossier AIGLE dans L:finoiseau et enregistré le
fichier en 123.txt
**il y a le dossier FIN et un nouveau dossier AIGLE qui ont changés**
--------------------------------------------------------

j'ouvre mon fichier excel :
L:debutcoincoincuicuilalatutuazert.xls

je lance la macro, je me retrouve avec :
L:fincoincoincuicuilalatutuazert.txt
elle a donc créee 3 dossiers, TUTU dans LALA dans CUICUI dans
L:fincoincoin et enregistré le fichier en azert.txt
**il y a le dossier FIN et 3 nouveaux dossiers TUTU, LALA et CUICUI qui ont
changés**
--------------------------------------------------------

Finallement je sais pas si c'est plus claire ?? :-)
Merci encore pour votre aide
Avatar
Norvi
Bonsoir,

Alors ainsi, ca devrait marcher, en sachant que je suppose que le debut
et fin son toujours après C:, que le fichier est enregistrer en TXT.
Si les reportoires n'existgent pas, il seront créer, les uns après
les autres.

Sub Enregistre_Une_Copie_en_TXT()
Dim MaMatrice()
Dim NomFic, Mon_Dossier, Chemin_A_Creer As String
Dim I, J, K, Ine As Integer
NomFic = Application.ActiveWorkbook.Path
J = 2
Do While K < Len(NomFic)
K = J - 1
Ine = Ine + 1
For I = 0 + K To Len(NomFic) Step 1
If Mid$(NomFic, I, 1) = "" Then Exit For
Next
For J = I + 1 To Len(NomFic) Step 1
If Mid$(NomFic, J, 1) = "" Then Exit For
Next
ReDim Preserve MaMatrice(Ine)
MaMatrice(Ine) = Mid$(NomFic, I + 1, J - I - 1)
Loop
For I = 3 To Ine
Cells(I, 1).Value = MaMatrice(I - 1)
Chemin_Incremental = Chemin_Incremental & "" & MaMatrice(I - 1)
On Error Resume Next
Chemin_A_Creer = "c:fin" & Chemin_Incremental
Mon_Dossier = GetAttr(Chemin_A_Creer) And 0
If Err.Number <> 0 Then
MkDir Chemin_A_Creer
End If
Next
ActiveWorkbook.SaveAs Filename:=Chemin_A_Creer & "" &
Left(Application.ActiveWorkbook.Name,
Len(Application.ActiveWorkbook.Name) - 4), FileFormat:=xlText
End Sub
Avatar
FxM
Bonsoir,

Tu peux t'inspirer de ce qui suit.

@+
FxM

Sub test()

'nom du fichier actuel (le fichier doit avoir été enregistré)
nomacc = ActiveWorkbook.FullName

'futur nom en x:fin???xxx.txt
nomfut = Application.Substitute(nomacc, "debut", "fin")
nomfut = Application.Substitute(nomfut, ".xls", ".txt")

'découpage en fonction des
tablo = Split(nomfut, "")

'recréer le chemin petit à petit
For a = 0 To UBound(tablo) - 1
chefut = ""
For b = 0 To a
chefut = chefut & "" & tablo(b)
Next b
chefut = Right(chefut, Len(chefut) - 1)
'chefut est la portion de chemin

's = "" si la portion n'existe pas
'dans ce cas créer le s/r
s = Dir(chefut, vbDirectory)
If s = "" Then MkDir chefut
Next a

'faire la sauvegarde
ActiveWorkbook.SaveAs Filename:=nomfut, _
FileFormat:=xlText, CreateBackup:úlse

End Sub




Bonjour à vous,

j'ai des bouts de code, mais j'aimerais aller plus loin... !

Imaginons que j'ai 2 dossiers :
L:/debut
L:/fin

Dans le premier dossier, j'ai 1 dossier Toto, avec 1 fichier Excel :
L:debutTotofichier1.xls
L:fin

Le but de la macro, c'est que quand je l'execute à partir du fichier1.xls,
le fichier s'enregistre en texte separer par des tabulations dans le dossier
Toto du dossier fin...!
L:finTotofichier1.txt
Donc la macro aura créee un nouveau dossier Toto.
En resumer,
L:debutTotofichier1.xls devient L:finTotofichier1.txt
donc pour generaliser,
un fichier ouvert ayant comme adresse : L:debut*§£#.xls
sera enregistrter dans L:fin*§£#.txt (separateur tabs)

Voila, je vous remercie d'avance pour votre aide

Max


Avatar
tinou
Youhou !!
Merci encore a vous...!
Les 2 fonctionnent...
Norvi, apres avoir lancer ta macro, les noms des dossiers
créé apparaissent dans les cellules de la colonne A...
donc ecrase les infos...
Quant à toi FxM, euh, ben rien, c'est nickel...
merci pour ta macrotaillefine 0 %... :-)

C'est ce que j'aime en VBA, y a pour un scenario plusieurs chemins
differents...
tous aussi instructifs les uns que les autres !

MERCI

Tinou
Avatar
Norvi
Ouch, désolé.....
C'était pour vérifier qu'à la base je selectionnais correctement les
nom de dossier....
La ligne que j'ai oublié de supprimer :
Cells(I, 1).Value = MaMatrice(I - 1)
Encore désolé ;)
N.
Avatar
FxM
Youhou !!
Merci encore a vous...!
Les 2 fonctionnent...
Norvi, apres avoir lancer ta macro, les noms des dossiers
créé apparaissent dans les cellules de la colonne A...
donc ecrase les infos...
Quant à toi FxM, euh, ben rien, c'est nickel...
merci pour ta macrotaillefine 0 %... :-)


De rien, tu passes nous voir quand tu veux :o)

@+
FxM

Avatar
tinou
Salut FxM,

c'est encore moi...
est-ce que c'est possible de rajouter
l'ouverture du nouveau dossier (chemfut)
reduit dans l'explorer ?????

En gros, une fois que TA macro (ci dessous)
a sauvegarder en txt, le nouveau dossier s'ouvre
dans la barre des taches...

Merci encore.

Tinou

Ps : bientot je vais mettre plein de nouveaux posts...
j'espere que tu sera là.


******************************
Sub test()

'nom du fichier actuel (le fichier doit avoir été enregistré)
nomacc = ActiveWorkbook.FullName

'futur nom en x:fin???xxx.txt
nomfut = Application.Substitute(nomacc, "debut", "fin")
nomfut = Application.Substitute(nomfut, ".xls", ".txt")

'découpage en fonction des
tablo = Split(nomfut, "")

'recréer le chemin petit à petit
For a = 0 To UBound(tablo) - 1
chefut = ""
For b = 0 To a
chefut = chefut & "" & tablo(b)
Next b
chefut = Right(chefut, Len(chefut) - 1)
'chefut est la portion de chemin

's = "" si la portion n'existe pas
'dans ce cas créer le s/r
s = Dir(chefut, vbDirectory)
If s = "" Then MkDir chefut
Next a

'faire la sauvegarde
ActiveWorkbook.SaveAs Filename:=nomfut, _
FileFormat:=xlText, CreateBackup:úlse

End Sub
1 2