Bonjour, j'espère que tout le monde a passé une bonne fête de Noël.
J'ai créé un fichier excel avec une liste de client avec nom, prénom, etc avec au bout de la ligne un bouton permettant de copier un dossier vierge pour le coller dans un autre dossier tout en le renommant avec les infos du client.
Mon problème est qu'il y a beaucoup de clients, donc j'ai été obligé de créer des dossiers avec les lettres de l'alphabet pour les classer. Et donc il faut le déplacer manuellement à chaque fois dans le bon répertoire.
Est-il possible de copier le dossier vierge pour le coller dans le bon répertoire alphabétique directement?
J'ai essayé d'incorporer la fonction STXT pour qu'il récupère la premier lettre du nom dans le tableau excel mais ça ne fonctionne pas, voici le code de base :
Sub copier()
repertorier_fichier "\\domman.ad\data\DOSSIERS CLIENTS\- dossier à ne pas effacer ou déplacer\patient", "\\domman.ad\data\DOSSIERS CLIENTS"
End Sub
Public Sub repertorier_fichier(Source As String, Destination As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFolder Source, Destination, True
Set fso = Nothing
End Sub
Private Sub CommandButton69_Click()
y = Cells(1, 1).Height
ligne = 1
While y < CommandButton69.Top
ligne = ligne + 1
y = y + Cells(ligne, 1).Height
Wend
repertorier_fichier "\\domman.ad\data\DOSSIERS CLIENTS\- dossier à ne pas effacer ou déplacer\patient", "\\domman.ad\data\DOSSIERS CLIENTS"
Dim AncienNom As String, NouveauNom As String
AncienNom = "\\domman.ad\data\DOSSIERS CLIENTS\programme\GESTION POIDS - date P.E.C\ipp, nom, prénom, date naissance.XLS"
NouveauNom = "\\domman.ad\data\DOSSIERS CLIENTS\programme\GESTION POIDS - date P.E.C\" & Range("D" & ligne) & ", " & Range("A" & ligne) & ", " & Range("B" & ligne) & ", " & Range("C" & ligne) & ".xls"
Name AncienNom As NouveauNom
AncienNom = "\\domman.ad\data\DOSSIERS CLIENTS\programme\"
NouveauNom = "\\domman.ad\data\DOSSIERS CLIENTS\" & Range("A" & ligne) & " " & Range("B" & ligne) & " " & Range("C" & ligne)
Name AncienNom As NouveauNom
End Sub