VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même nom

[rems]

Bonjour,

Nouveau sur ce forum et débutant en VBA, je cherche à créer un dossier dont le nom varie selon le fichier qui sera enregistré dans ce dossier.

Je souhaite partir d'une feuille EXCEL (fiche précédemment créée) qui devra être sauvegardée dans :
1/ un dossier à créer sous C:\Fiches\ et qui portera le nom contenu dans la cellule I4 de la feuille EXCEL ;
2/ une fois le dossier créé (et vérification faite qu'il n'existe pas déjà), la feuille EXCEL devra être enregistrée dans ce dossier créé sous le même nom contenu dans la cellule I4.xls

Avec mes maigres connaissances, j'en suis au code ci-dessous mais je n'arrive pas au résultat souhaité (pour le moment j'ai une dialog box qui me permet d'aller l'enregistrer mais ce n'est pas ce que je souhaite ...).
- - - - - - - - -
Sub Savesheet()
ActiveSheet.Name = Range("I4").Text
InitialFileName = Range("I4").Text
If Len(Dir("C:\Fiches\" & Range("I4").Value, vbDirectory)) = 0 Then
MkDir "C:\Fiches\" & Range("I4").Value
End If
Application.Dialogs(xlDialogSaveAs).Show CStr(ThisWorkbook.ActiveSheet.Range("I4").Value)
End Sub
- - - - - - - - -
Si vous avez une solution à m'apporter, je suis preneur.
Merci d'avance pour votre aide.
Bonne soirée.

 

[kjin]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

bonsoir,

Sub Savesheet()
Nom = [I4]
ActiveSheet.Copy
ActiveSheet.Name = Nom
If Dir("C:\Fiches\", vbDirectory) = "" Then MkDir "C:\Fiches\"
With ActiveWorkbook
    .SaveAs "C:\Fiches\" & Nom & "xls"
    .Close
End With
End Sub

A ce stade il n'y a pas de contrôle d'erreur (validité du nom, fichier existant...)
A+
kjin

 

[rems]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Bonsoir et merci beaucoup pour votre réponse.

Je n'arrive toutefois pas à la création du nouveau dossier C:/Fiches/Nom et qui accueillera ensuite le fichier xl Nom.xls.
Dois-je modifier If Dir("C:\Fiches\", vbDirectory) = "" Then MkDir "C:\Fiches\"
par If Dir("C:\Fiches\" & Nom, vbDirectory) = "" Then MkDir "C:\Fiches\" & Nom ?

Merci encore pour votre aide,

 

[Staple1600]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Bonsoir à tous

kjin:
Content de te croiser , sieur.

rems:
En fait tu veux créer un sous-répertoire dans un répertoire existant.
Essaies ceci peut-être (non testé)
If Dir("C:\Fiches\" & Nom, vbDirectory) = "" Then MkDir "C:\Fiches\" & Nom

EDITION: Je viens de tester. Cela fonctionne.
rems:
Je viens de voir que tu avais toi-même répondu à ta question (lol)
Pourquoi ne pas avoir testé?

 

[MJ13]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Bonjour à tous

Pour la création des dossiers, Kiki29 nous avait donné ce code que je trouve à l'utilisation très pratique .

Code VBA:
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
(ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
Sub CreationDossier(sNomRep As String)
'ChDrive "D"
SHCreateDirectoryEx 0&, sNomRep, 0&
End Sub
Private Sub Tst()
Dim Rep As String
Rep = "D:\repA\repB\repC\RepD"
CreationDossier Rep
End Sub

 

[rems]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Bonsoir à tous

kjin:
Content de te croiser , sieur.

rems:
En fait tu veux créer un sous-répertoire dans un répertoire existant.
Essaies ceci peut-être (non testé)
If Dir("C:\Fiches\" & Nom, vbDirectory) = "" Then MkDir "C:\Fiches\" & Nom

EDITION: Je viens de tester. Cela fonctionne.
rems:
Je viens de voir que tu avais toi-même répondu à ta question (lol)
Pourquoi ne pas avoir testé?

Bonjour,
Merci pour vos retours. J'ai testé cette modification, malheureusement j'ai toujours un message "erreur d'exécution "68" périphérique non disponible".
Je ne vois pas bien ce qui cloche ...

Par ailleurs, pour le saveas, comment adapter le .SaveAs "C:\Fiches\" & Nom & "xls" (le fichier Nom va être enregistré dans le répertoire Fiches et non dans le sous-répertoire Nom (sous répertoire du répertoire Fiche) ?
Est-ce .SaveAs "C:\Fiches\" & Nom & Nom & "xls" ... ?

Merci d'avance pour votre aide,
Bon Dimanche.

 

[Staple1600]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Bonjour à tous

rems
Le test OK chez moi, c'était la macro a, j'ai rajouté la macro b qui fonctionne aussi.
La seule différence est qu'en b Nom est le valeur de la cellule A1 (en a, Nom est en dur dans le code)
PS: ces deux codes ne concernent que la création de dossiers
et ces deux macros les créent bien s'ils n'existent pas (ici pour l'exemple) dans C:\Temp
Donc si tu veux tester, crées d'abord un dossier Temp sur ton disque C

Sub a()
Dim Nom$
Nom = "TEST1213"
If Dir("C:\Temp\" & Nom, vbDirectory) = "" Then MkDir "C:\Temp\" & Nom
End Sub

Sub b()
Dim Nom$
Sheets(1).[A1] = "Test1213b" 'ici juste pour test pour être sur que A1 n'est pas vide
Nom = Sheets(1).[A1].Text
If Dir("C:\Temp\" & Nom, vbDirectory) = "" Then MkDir "C:\Temp\" & Nom
End Sub

 

[MJ13]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Re

Depuis le début, on ne sait pas ce qu'il y a dans Nom, c'est peut-être la le problème .

En plus on ne connaît pas ta version (car "toutes versions", si cela ne fonctionne pas, c'est pas très judicieux).

 

[Staple1600]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Salut MJ13

j'ai toujours un message "erreur d'exécution "68" périphérique non disponible".

Ce lien n'existe plus (à mon avis) vient de cette ligne
Application.Dialogs(xlDialogSaveAs).Show CStr(ThisWorkbook.ActiveSheet.Range("I4").Value)
Car ici on n'a pas de path, juste la valeur de Nom

PS: Ce qui m'intrique c'est le toujours, on peut supposer que dés le départ ce message apparaissait.
Cette info aurait été utile dans le premier message si c'est le cas

De plus ces variables ne sont ni déclarées ni utilisées (mais bon c'est normal le demandeur est un jeune padawan en VBA)

ActiveSheet.Name = Range("I4").Text
InitialFileName = Range("I4").Text

 

[MJ13]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Re

Application.Dialogs(xlDialogSaveAs).Show CStr(ThisWorkbook.ActiveSheet.Range("I4").Value)

Dans ce cas, il faut apprendre aux gens à debugger. C'est pas très compliqué .

 

[Staple1600]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Re

Pour le moment j'attends que rems teste la création de dossier avec succès.
Ensuite on passera à l’enregistrement du classeur.

 

[MJ13]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Re

Pour le moment j'attends que rems teste la création de dossier avec succès.
Ensuite on passera à l’enregistrement du classeur.

OK, Jean-Marie. Merci pour ta patience.

Bon Dimanche .

 

[rems]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Bonjour à tous

rems
Le test OK chez moi, c'était la macro a, j'ai rajouté la macro b qui fonctionne aussi.
La seule différence est qu'en b Nom est le valeur de la cellule A1 (en a, Nom est en dur dans le code)
PS: ces deux codes ne concernent que la création de dossiers
et ces deux macros les créent bien s'ils n'existent pas (ici pour l'exemple) dans C:\Temp
Donc si tu veux tester, crées d'abord un dossier Temp sur ton disque C

Sub a()
Dim Nom$
Nom = "TEST1213"
If Dir("C:\Temp\" & Nom, vbDirectory) = "" Then MkDir "C:\Temp\" & Nom
End Sub

Sub b()
Dim Nom$
Sheets(1).[A1] = "Test1213b" 'ici juste pour test pour être sur que A1 n'est pas vide
Nom = Sheets(1).[A1].Text
If Dir("C:\Temp\" & Nom, vbDirectory) = "" Then MkDir "C:\Temp\" & Nom
End Sub

Bonjour,

Je me suis basé sur vos codes et cela fonctionne désormais !
Merci beaucoup pour votre aide,
Bonne fin de week-end.

 

[Staple1600]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Re

rems:
Par curiosité (et parce que cela pourrait intéresser d'autres membres du forum), tu peux publier, stp, ta macro finale et fonctionnelle ?

 

[rems]

Re : VBA > Créer un dossier nom variable et y enregistrer un fichier portant le même

Re

rems:
Par curiosité (et parce que cela pourrait intéresser d'autres membres du forum), tu peux publier, stp, ta macro finale et fonctionnelle ?

Bonsoir,

Tout d'abord, désolé de ne pas avoir exprimé correctement mes besoins et réponses ...

Veuillez trouver ci-dessous le code utilisé (je ne sais pas si c'est la façon la plus correcte de l'écrire mais ça fonctionne) pour :
- la création d'une nouvelle feuille (+ copie valeur de certaines cellules) qui portera le nom de la cellule I4 (Nom) ;
- la création d'un dossier (en vérifiant au préalable qu'il n'existe pas déjà) qui tire son nom de la cellule I4 (Nom) de la feuille nouvellement créée ;
- la proposition de le sauvegarder selon un chemin précis (C:\Fiches\)

Je suis preneur de vos commentaires et améliorations.
Merci à tous pour votre aide.
Bonne soirée,
Rems

- - - - - - - - - - - - - - -
Sub Savesheet()
ActiveSheet.Copy
Nom = [I4]
ActiveSheet.Name = Nom
InitialFileName = Nom
ActiveSheet.Range("A1:J45").Copy
ActiveSheet.Range("A1:J45").PasteSpecial xlPasteValues
Dim FolderPath As String
Dim TestStr As String
FolderPath = "C:\Fiches\" & Nom
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
TestStr = ""
On Error Resume Next
TestStr = Dir(FolderPath)
On Error GoTo 0
If TestStr = "" Then
MkDir "C:\Fiches\" & Nom
ChDir "C:\Fiches\" & Nom
Application.Dialogs(xlDialogSaveAs).Show CStr(ThisWorkbook.ActiveSheet.Range("I4").Value)
Else
MsgBox "ATTENTION : folder already exists."
Application.Dialogs(xlDialogSaveAs).Show CStr(ThisWorkbook.ActiveSheet.Range("I4").Value)
End If
End Sub