Macro enregistrer sous... dans dossier spécifique

Pierl

XLDnaute Nouveau
Bonjour,
J'ai créé une macro permettant d'enregistrer une fiche de renseignements dans un dossier client à l'aide d'un bouton prévu à cet effet.
Ma macro va sauvegarder automatiquement mon document dans un dossier portant le numéro du client et son nom, contenus tous deux dans la fiche de renseignements. Cela fonctionne très bien tant que le nom est écrit exactement de la même manière.
C'est pourquoi je voudrais que la recherche du dossier s'opère uniquement sur le numéro à 4 chiffres du client, sans prendre en compte la manière dont le nom est écrit (ex. 1234 - Jambois Sarl: la recherche doit s'effectuer sur le numéro 1234).
Si quelqu'un peut m'aider. ..
D'avance merci;-)
 

gilbert_RGI

XLDnaute Barbatruc
Re : Macro enregistrer sous... dans dossier spécifique

alors de ce chemin tu n'en fais rien car il ne t’intéresse pas à ton boulot

mais tu fais de même pour ton fichier avec le disque "M" je ne connais pas les sous répertoires

ce qui devrait donner

"M:\premier sousdossier\deuxieme sousdossier\troisième sousdossier\nomdetonfichier&lextension"
 

Pierl

XLDnaute Nouveau
Re : Macro enregistrer sous... dans dossier spécifique

Voilà le l'arborescence et le nom de mon fichier à enregistrer dans un dossier nommé "configuration clients":
M:\DOCUMENTS QUALITE\SOMMAIRE ET DOC ISO V3 2012\NOUVEAUX DOCS\DTIR\DTIR 2015 version 8.9

et voilà le chemin pour le dossier cible : M:\Configuration clients

et enfin, voilà le code de ma macro:

Sub Save_new()
'
Dim GestionFichier As New Scripting.FileSystemObject
' On commence par définir une variable de type Folder :
Dim Dossier As Folder, res As String, IDclient As Integer, LGidclient As Integer, chemin As String
Dim Creation As String
Dim nomfichier As String
modele = ThisWorkbook.Path & "\" & ThisWorkbook.Name
MsgBox modele
ActiveSheet.Unprotect
IDclient = Sheets(1).Range("H4")
nomclient = Sheets(1).Range("C4").Value
LGidclient = Len(Sheets(1).Range("H4"))
nomfichier = "Dtir " & nomclient & "_" & IDclient & " - " & Format(Date, "dd-mm-yy") & ".xlsm"
chemin = "M:\" & "Configuration clients\"

' Cette boucle parcourt tous les dossiers
For Each Dossier In GestionFichier.GetFolder(ThisWorkbook.Path & chemin).SubFolders
res = Left(Dossier.Name, LGidclient)
'MsgBox res & " " & IDclient
If res = IDclient Then
'sauvegarde du fichier Excel
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & chemin & Dossier.Name & "\" & nomfichier
Application.DisplayAlerts = False
'Workbooks(nomfichier).Close SaveChanges:=True
Application.DisplayAlerts = True
Set GestionFichier = Nothing
Exit Sub
End If
Next
' si le dossier n'existe pas création
Creation = ThisWorkbook.Path & chemin & IDclient & " - " & nomclient & "\"
MkDir (Creation)
'puis sauvegarde du fichier Excel
ActiveSheet.Protect
ActiveWorkbook.SaveAs Filename:=Creation & nomfichier
Application.DisplayAlerts = False
'Workbooks(nomfichier).Close SaveChanges:=True
Application.DisplayAlerts = True
Set GestionFichier = Nothing
End Sub


Tu peux me dire où je mets mes chemins?
Pour le reste, même principe, on recherche le code client et on sauvegarde le fichier dedans;
 

gilbert_RGI

XLDnaute Barbatruc
Re : Macro enregistrer sous... dans dossier spécifique

donc voilà les lignes à changer si j'ai bien compris


chemin="M:\DOCUMENTS QUALITE\SOMMAIRE ET DOC ISO V3 2012\NOUVEAUX DOCS\DTIR\DTIR 2015 version 8.9" & "\" & "Configuration clients\"

...................
For Each Dossier In GestionFichier.GetFolder(chemin).SubFolders

....................


ActiveWorkbook.SaveAs Filename:= chemin & Dossier.Name & "\" & nomfichier


.............

Creation = chemin & IDclient & " - " & nomclient & "\"




en espérant que cela soit juste !!!!!!
 

gilbert_RGI

XLDnaute Barbatruc
Re : Macro enregistrer sous... dans dossier spécifique

ce qui doit faire :

Code:
Sub Save_DPV()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' On commence par définir une variable de type Folder :
    Dim Dossier As Folder, res As String, IDclient As Integer, LGidclient As Integer, chemin As String
    Dim Creation As String
    ActiveSheet.Unprotect
    IDclient = Sheets(1).Range("h4")
    nomclient = Sheets(1).Range("D8").Value
    LGidclient = Len(Sheets(1).Range("h4"))
    nomfichier = "DPV " & nomclient & "_" & IDclient & " - " & Format(Date, "dd-mm-yy") & ".xlsm"
    chemin = "M:\DOCUMENTS QUALITE\SOMMAIRE ET DOC ISO V3 2012\NOUVEAUX DOCS\DTIR\DTIR 2015 version 8.9" & "\" & "Configuration clients\"

    ' Cette boucle parcourt tous les dossiers
    For Each Dossier In GestionFichier.GetFolder(chemin).SubFolders
        res = Left(Dossier.Name, LGidclient)
        If res = IDclient Then
            'sauvegarde du fichier Excel
            ActiveWorkbook.SaveAs Filename:=chemin & Dossier.Name & "\" & nomfichier
            Set GestionFichier = Nothing
            Exit Sub
        End If
    Next
    ' si le dossier n'existe pas création
    Creation = chemin & IDclient & " - " & nomclient & "\"
    MkDir (Creation)
    ActiveSheet.Protect
    ActiveWorkbook.SaveAs Filename:=Creation & nomfichier
    Set GestionFichier = Nothing

End Sub



hummmm je vois dans le chemin un . (version 8.9) ça c'est pas bon le point étant réservé normalement à séparer le fichier de son extension peut créer une erreur ??? si possible remplacer par un tiret

 
Dernière édition:

gilbert_RGI

XLDnaute Barbatruc
Re : Macro enregistrer sous... dans dossier spécifique

pour confirmer mes écrits

[h=3]Caractères interdits dans les noms de fichiers Windows[/h]
Conventions et limitations dans le système de fichiers NTFS (" NT File System " - " New Technologie File System "), à partir de Windows NT en 1993 :

  • Nom suivi d'une extension éventuelle, séparée par un "." (un point)
    Longueur maximale du nom d'un fichier : 255 caractères, extension incluse (mais, en ligne de commande, comme par exemple dans la boîte d'invite de commande, vous ne pouvez créer que des noms de fichiers comportant au maximum 253 caractères).
  • Nombre de sous-niveaux maximum : 15
  • Longueur maximale du chemin d'accès complet à un fichier : 260 caractères (limite imposée par le shell de Windows - en théorie, la longueur maximale " approximative " [SUP](Ce lien n'existe plus)[/SUP] d'un chemin d'accès complet est de 32.767 caractères).
  • Le caractère antislash ( backslash - \ ) est le séparateur de chemins
  • Les caractères suivants sont réservés pour des usages spéciaux et ne doivent pas être utilisés dans le nom lui-même :
    • < (plus petit que; less than)
    • > (plus grand que; greater than)
    • : (deux points; colon)
    • " (double appostrophe; double quote)
    • / (slash; barre de fraction; forward slash)
    • \ (antislash; backslash)
    • | (barre verticale; vertical bar; pipe)
    • ? (point d'interrogation; question mark)
    • * (astérisque; asterisk)
  • Les caractères non imprimables (les valeurs binaires dans l'intervale 00 à 31) sont interdits. Toutefois, les caractères de l'intervale binaire 01 à 31 peuvent être utilisés dans le nommage des chaînes Ce lien n'existe plus (Fichiers totalement cachés attaché à un fichier visible).
  • .\ représente le répertoire courant
  • ..\ représente le répertoire parent
 

Pierl

XLDnaute Nouveau
Re : Macro enregistrer sous... dans dossier spécifique

ce que tu appelles chemin, c'est le chemin du dossier ou doit être enregistré le fichier?
Si oui, mon dossier de sauvegarde est le dossier nommé "Configuration clients" et il est directement à la racine de "M:".
J'écris donc : chemin = "M:\Configuration clients\" ???
 

Pierl

XLDnaute Nouveau
Re : Macro enregistrer sous... dans dossier spécifique

J'ai ajouté une message box juste avant la ligne en défaut, mais ça marche pas!
voilà ma macro (comment fais-tu pour afficher le code d'une macro dans une fenetre, comme tu fais?)


Sub Save_new()
'
Dim GestionFichier As New Scripting.FileSystemObject
' On commence par définir une variable de type Folder :
Dim Dossier As Folder, res As String, IDclient As Integer, LGidclient As Integer, chemin As String
Dim Creation As String
ActiveSheet.Unprotect
IDclient = Sheets(1).Range("H4")
nomclient = Sheets(1).Range("C4").Value
LGidclient = Len(Sheets(1).Range("H4"))
nomfichier = "Dtir " & nomclient & "_" & IDclient & " - " & Format(Date, "dd-mm-yy") & ".xlsm"
chemin = "M:\Configuration clients\"

' Cette boucle parcourt tous les dossiers
For Each Dossier In GestionFichier.GetFolder(chemin).SubFolders
res = Left(Dossier.Name, LGidclient)
'MsgBox res & " " & IDclient
If res = IDclient Then
'sauvegarde du fichier Excel
ActiveWorkbook.SaveAs Filename:=chemin & Dossier.Name & "\" & nomfichier
Set GestionFichier = Nothing
Exit Sub
End If
Next
' si le dossier n'existe pas création
Creation = chemin & IDclient & " - " & nomclient & "\"
MkDir (Creation)
'puis sauvegarde du fichier Excel
ActiveSheet.Protect
ActiveWorkbook.SaveAs Filename:=Creation & nomfichier
Set GestionFichier = Nothing

End Sub
 

Discussions similaires

Réponses
3
Affichages
294

Statistiques des forums

Discussions
312 198
Messages
2 086 149
Membres
103 132
dernier inscrit
hedfahmi