Microsoft 365 VBA : Création fichier via MkDir & enregistrement automatique

Arnaud59000

XLDnaute Nouveau
Bonjour tout le monde !


Je reviens vers vous avec un nouveau problème :

Je souhaite enregistrer automatiquement mes onglets dans un nouveau fichier en fonction de la date actuelle. C'est c'est bon.

Cependant, quand je veux utiliser la fonction MkDir() pour créer mon fichier, la première fois cela fonctionne, mais à partir de la seconde j'obtiens une erreur de chemin (Erreur"75")

Voici mon code :



Sub CopieFeuilles()

Dim Monchemin As String
Dim MonDossier As String


Monchemin = "XXXXXXXXXX"
MonDossier = Format(Now(), " mmyyyy")


[c'est à partir de ici que les problèmes commencent]

'If CBool(PathFileExists(Monchemin + MonDossier)) Then
'If Dir("XXXXXXXXX + MonDossier, vbDirectory) <> "" Then
MsgBox ("ok")

Else

MkDir (Monchemin + MonDossier)

End If

For Each sh In ActiveWorkbook.Sheets
If Not sh.Name Like "*TCD*" And Not sh.Name Like "*ADM*" And Not sh.Name Like "*BDD*" Then


sh.Copy

ActiveWorkbook.SaveAs Monchemin + MonDossier + "\" & sh.Name & Format(Now(), " mmyyyy")
ActiveWorkbook.Close

End If
Next

End Sub


Merci d'avance pour votre aide.
 
Solution
Bonsoir Arnaud COGEZ,

Si le fichier contenant la macro est enregistré vous pouvez créer le sous-dossier comme ceci :
VB:
Monchemin = ThisWorkbook.Path & "\" 'dossier existant, à adapter
MonDossier = "XXXXXXXXXX" & Format(Now, " mmyyyy") 'nom du sous-dossier
If Dir(Monchemin & MonDossier, vbDirectory) = "" Then MkDir Monchemin & MonDossier
A+

job75

XLDnaute Barbatruc
Bonsoir Arnaud COGEZ,

Si le fichier contenant la macro est enregistré vous pouvez créer le sous-dossier comme ceci :
VB:
Monchemin = ThisWorkbook.Path & "\" 'dossier existant, à adapter
MonDossier = "XXXXXXXXXX" & Format(Now, " mmyyyy") 'nom du sous-dossier
If Dir(Monchemin & MonDossier, vbDirectory) = "" Then MkDir Monchemin & MonDossier
A+
 

Discussions similaires