renommer fichiers (message à Michel B)

Bonjour gilles,

Chez moi, l'appli fonctionne correctement. Ceci dit
pour te facilter la tâche, j'ai retravaillé le code
original que j'inclus ici, toutefois je continue vers
ma lancer pour créer une application robuste.

Voici donc ce que ça donne, tu y trouveras peut-être
ton bonheur.

Sub prefic082()

Const cteMaxf = 30000
Const cteMinf = 1

Const cteDossier = "C:Q.S.E3arborescence affairef-Q.S.E"

Dim Compteur, Position, Longueur, Boucle As Integer
Dim NomCourt, NomLong, NouveauNom As String

Dim f() As String
Dim oFS, oLecteur, oFichier, oFolder
Dim varListeNbr As Long

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder(cteDossier)

Application.ScreenUpdating = False
ChDir cteDossier

varListeNbr = oFolder.Files.Count
Compteur = 1
If ((varListeNbr > cteMinf) And (varListeNbr < cteMaxf))
Then
ReDim f(varListeNbr)
For Each oFichier In oFolder.Files
Position = InStr(1, oFichier.Name, ".xls", vbTextCompare)
If (Position > 0) Then
If ((Len(oFichier.Name) - 3) = Position) Then
f(Compteur) = oFichier.Name
Compteur = (Compteur + 1)
End If
End If
Next oFichier

Longueur = Len(Range("B8").Value)
For Boucle = 1 To (Compteur - 1)
If (Mid(f(Boucle), 1, Longueur) <> Range("B8").Value) Then
Application.DisplayAlerts = False
NomCourt = f(Boucle)
NomLong = cteDossier & "" & NomCourt
NouveauNom = cteDossier & "" & Range("B8").Value & f
(Boucle)
oFS.CopyFile NomLong, NouveauNom
Kill NomLong
Application.DisplayAlerts = True
End If
Next

End If

End Sub

@+
Michel

-----Message d'origine-----
ReBonjour MICHEL
Apparemment les 2 tentatives de réponses au fil précédent
que j'ai faites ne sont pas passées
Le prefixe à inscrire est défini par B8
Le prefixe à exclure aussi, au cas improbable ou il
aurait

deja été mis
En fait le projet que je propose aux utilisateurs est le
suivant :
Je crée un repertoire, et des s/rep
Je copie dans un de ces s/rep ,des fichiers (env une
quinzaine)provenant d'un autre lecteur
J'ouvre ces fichiers
Je copie la page ou se situe la macro sur la première
page

de ces fichiers (ça ne marche pas pour l'instant)
Je sauvegarde ces fichiers et les ferme
Je renomme les fichiers
Je renomme le rep principal

Donc il n'ya pas de chance qu'ils soient deja nommés
Sinon , j'ai tasté le code XLS que tu as conçu. C'est du
beau travail
Par contre, il semble que les fichiers originaux ne
soient

pas détruits (normal ?)

Merci encore
A+
gilles

.

merci Michel
je regarde ça
à+
gilles

-----Message d'origine-----
Bonjour gilles,

Chez moi, l'appli fonctionne correctement. Ceci dit
pour te facilter la tâche, j'ai retravaillé le code
original que j'inclus ici, toutefois je continue vers
ma lancer pour créer une application robuste.

Voici donc ce que ça donne, tu y trouveras peut-être
ton bonheur.

Sub prefic082()

Const cteMaxf = 30000
Const cteMinf = 1

Const cteDossier = "C:Q.S.E3arborescence affairef-
Q.S.E"

Dim Compteur, Position, Longueur, Boucle As Integer
Dim NomCourt, NomLong, NouveauNom As String

Dim f() As String
Dim oFS, oLecteur, oFichier, oFolder
Dim varListeNbr As Long

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder(cteDossier)

Application.ScreenUpdating = False
ChDir cteDossier

varListeNbr = oFolder.Files.Count
Compteur = 1
If ((varListeNbr > cteMinf) And (varListeNbr < cteMaxf))
Then
ReDim f(varListeNbr)
For Each oFichier In oFolder.Files
Position = InStr(1, oFichier.Name, ".xls", vbTextCompare)
If (Position > 0) Then
If ((Len(oFichier.Name) - 3) = Position) Then
f(Compteur) = oFichier.Name
Compteur = (Compteur + 1)
End If
End If
Next oFichier

Longueur = Len(Range("B8").Value)
For Boucle = 1 To (Compteur - 1)
If (Mid(f(Boucle), 1, Longueur) <> Range("B8").Value) Then
Application.DisplayAlerts = False
NomCourt = f(Boucle)
NomLong = cteDossier & "" & NomCourt
NouveauNom = cteDossier & "" & Range("B8").Value & f
(Boucle)
oFS.CopyFile NomLong, NouveauNom
Kill NomLong
Application.DisplayAlerts = True
End If
Next

End If

End Sub

@+
Michel

-----Message d'origine-----
ReBonjour MICHEL
Apparemment les 2 tentatives de réponses au fil
précédent

que j'ai faites ne sont pas passées
Le prefixe à inscrire est défini par B8
Le prefixe à exclure aussi, au cas improbable ou il
aurait

deja été mis
En fait le projet que je propose aux utilisateurs est
le

suivant :
Je crée un repertoire, et des s/rep
Je copie dans un de ces s/rep ,des fichiers (env une
quinzaine)provenant d'un autre lecteur
J'ouvre ces fichiers
Je copie la page ou se situe la macro sur la première
page

de ces fichiers (ça ne marche pas pour l'instant)
Je sauvegarde ces fichiers et les ferme
Je renomme les fichiers
Je renomme le rep principal

Donc il n'ya pas de chance qu'ils soient deja nommés
Sinon , j'ai tasté le code XLS que tu as conçu. C'est du
beau travail
Par contre, il semble que les fichiers originaux ne
soient

pas détruits (normal ?)

Merci encore
A+
gilles

.

.

re-bonjour MICHEL
après test
le code renomme 4 fichier sur 8 puis met le message
erreur75 définie par le chemin
2 autres tentatives avec la meme effet mais un nbre de
renommage différent (3 puis 2)
Le code est dans un fichier sur le lecteur d
les fichiers sont sur un rep du C
cela peut il avoir un lien?
MERCI encore
à+
gilles

-----Message d'origine-----
Bonjour gilles,

Chez moi, l'appli fonctionne correctement. Ceci dit
pour te facilter la tâche, j'ai retravaillé le code
original que j'inclus ici, toutefois je continue vers
ma lancer pour créer une application robuste.

Voici donc ce que ça donne, tu y trouveras peut-être
ton bonheur.

Sub prefic082()

Const cteMaxf = 30000
Const cteMinf = 1

Const cteDossier = "C:Q.S.E3arborescence affairef-
Q.S.E"

Dim Compteur, Position, Longueur, Boucle As Integer
Dim NomCourt, NomLong, NouveauNom As String

Dim f() As String
Dim oFS, oLecteur, oFichier, oFolder
Dim varListeNbr As Long

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder(cteDossier)

Application.ScreenUpdating = False
ChDir cteDossier

varListeNbr = oFolder.Files.Count
Compteur = 1
If ((varListeNbr > cteMinf) And (varListeNbr < cteMaxf))
Then
ReDim f(varListeNbr)
For Each oFichier In oFolder.Files
Position = InStr(1, oFichier.Name, ".xls", vbTextCompare)
If (Position > 0) Then
If ((Len(oFichier.Name) - 3) = Position) Then
f(Compteur) = oFichier.Name
Compteur = (Compteur + 1)
End If
End If
Next oFichier

Longueur = Len(Range("B8").Value)
For Boucle = 1 To (Compteur - 1)
If (Mid(f(Boucle), 1, Longueur) <> Range("B8").Value) Then
Application.DisplayAlerts = False
NomCourt = f(Boucle)
NomLong = cteDossier & "" & NomCourt
NouveauNom = cteDossier & "" & Range("B8").Value & f
(Boucle)
oFS.CopyFile NomLong, NouveauNom
Kill NomLong
Application.DisplayAlerts = True
End If
Next

End If

End Sub

@+
Michel

-----Message d'origine-----
ReBonjour MICHEL
Apparemment les 2 tentatives de réponses au fil
précédent

que j'ai faites ne sont pas passées
Le prefixe à inscrire est défini par B8
Le prefixe à exclure aussi, au cas improbable ou il
aurait

deja été mis
En fait le projet que je propose aux utilisateurs est
le

suivant :
Je crée un repertoire, et des s/rep
Je copie dans un de ces s/rep ,des fichiers (env une
quinzaine)provenant d'un autre lecteur
J'ouvre ces fichiers
Je copie la page ou se situe la macro sur la première
page

de ces fichiers (ça ne marche pas pour l'instant)
Je sauvegarde ces fichiers et les ferme
Je renomme les fichiers
Je renomme le rep principal

Donc il n'ya pas de chance qu'ils soient deja nommés
Sinon , j'ai tasté le code XLS que tu as conçu. C'est du
beau travail
Par contre, il semble que les fichiers originaux ne
soient

pas détruits (normal ?)

Merci encore
A+
gilles

.

.

Bonjour gilles,

Pour tout les tests que j'ai fait à la maison en cours
de développement, le fichier se trouvait sur le lecteur
"E" et j'ai créer le même chemin sur le "C".

Peut-être que : les noms de fichiers sont en cause !

Peux-tu me donner un exemple de nom de fichier que
tu tests. J'éffecturai le même test !

P.S. J'en suis à la version 1.2.0 sur l'adresse que
je t'ai donné dans l'autre "post" qui est plein.

Michel B.

-----Message d'origine-----
re-bonjour MICHEL
après test
le code renomme 4 fichier sur 8 puis met le message
erreur75 définie par le chemin
2 autres tentatives avec la meme effet mais un nbre de
renommage différent (3 puis 2)
Le code est dans un fichier sur le lecteur d
les fichiers sont sur un rep du C
cela peut il avoir un lien?
MERCI encore
à+
gilles

-----Message d'origine-----
Bonjour gilles,

Chez moi, l'appli fonctionne correctement. Ceci dit
pour te facilter la tâche, j'ai retravaillé le code
original que j'inclus ici, toutefois je continue vers
ma lancer pour créer une application robuste.

Voici donc ce que ça donne, tu y trouveras peut-être
ton bonheur.

Sub prefic082()

Const cteMaxf = 30000
Const cteMinf = 1

Const cteDossier = "C:Q.S.E3arborescence affairef-
Q.S.E"

Dim Compteur, Position, Longueur, Boucle As Integer
Dim NomCourt, NomLong, NouveauNom As String

Dim f() As String
Dim oFS, oLecteur, oFichier, oFolder
Dim varListeNbr As Long

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder(cteDossier)

Application.ScreenUpdating = False
ChDir cteDossier

varListeNbr = oFolder.Files.Count
Compteur = 1
If ((varListeNbr > cteMinf) And (varListeNbr < cteMaxf))
Then
ReDim f(varListeNbr)
For Each oFichier In oFolder.Files
Position = InStr(1, oFichier.Name, ".xls", vbTextCompare)
If (Position > 0) Then
If ((Len(oFichier.Name) - 3) = Position) Then
f(Compteur) = oFichier.Name
Compteur = (Compteur + 1)
End If
End If
Next oFichier

Longueur = Len(Range("B8").Value)
For Boucle = 1 To (Compteur - 1)
If (Mid(f(Boucle), 1, Longueur) <> Range("B8").Value)
Then

Application.DisplayAlerts = False
NomCourt = f(Boucle)
NomLong = cteDossier & "" & NomCourt
NouveauNom = cteDossier & "" & Range("B8").Value & f
(Boucle)
oFS.CopyFile NomLong, NouveauNom
Kill NomLong
Application.DisplayAlerts = True
End If
Next

End If

End Sub

@+
Michel

-----Message d'origine-----
ReBonjour MICHEL
Apparemment les 2 tentatives de réponses au fil
précédent

que j'ai faites ne sont pas passées
Le prefixe à inscrire est défini par B8
Le prefixe à exclure aussi, au cas improbable ou il
aurait

deja été mis
En fait le projet que je propose aux utilisateurs est
le

suivant :
Je crée un repertoire, et des s/rep
Je copie dans un de ces s/rep ,des fichiers (env une
quinzaine)provenant d'un autre lecteur
J'ouvre ces fichiers
Je copie la page ou se situe la macro sur la première
page

de ces fichiers (ça ne marche pas pour l'instant)
Je sauvegarde ces fichiers et les ferme
Je renomme les fichiers
Je renomme le rep principal

Donc il n'ya pas de chance qu'ils soient deja nommés
Sinon , j'ai tasté le code XLS que tu as conçu. C'est
du

beau travail
Par contre, il semble que les fichiers originaux ne
soient

pas détruits (normal ?)

Merci encore
A+
gilles

.

.

.

bonjour MICHEL
merci de suivre mes balbutiements!
j'admire ton côté serviable
ci-joint 4 noms de fichiers utilisés

budget 1er juillet 2004
Etiquettes dossiers affaires
FNCreprise
plan de controles et convocations

Je ne voudrais pas abuser de ton temps,mais si tu vois
kekchose, je t'en remercie
à+
gilles

-----Message d'origine-----
Bonjour gilles,

Pour tout les tests que j'ai fait à la maison en cours
de développement, le fichier se trouvait sur le lecteur
"E" et j'ai créer le même chemin sur le "C".

Peut-être que : les noms de fichiers sont en cause !

Peux-tu me donner un exemple de nom de fichier que
tu tests. J'éffecturai le même test !

P.S. J'en suis à la version 1.2.0 sur l'adresse que
je t'ai donné dans l'autre "post" qui est plein.

Michel B.

-----Message d'origine-----
re-bonjour MICHEL
après test
le code renomme 4 fichier sur 8 puis met le message
erreur75 définie par le chemin
2 autres tentatives avec la meme effet mais un nbre de
renommage différent (3 puis 2)
Le code est dans un fichier sur le lecteur d
les fichiers sont sur un rep du C
cela peut il avoir un lien?
MERCI encore
à+
gilles

-----Message d'origine-----
Bonjour gilles,

Chez moi, l'appli fonctionne correctement. Ceci dit
pour te facilter la tâche, j'ai retravaillé le code
original que j'inclus ici, toutefois je continue vers
ma lancer pour créer une application robuste.

Voici donc ce que ça donne, tu y trouveras peut-être
ton bonheur.

Sub prefic082()

Const cteMaxf = 30000
Const cteMinf = 1

Const cteDossier = "C:Q.S.E3arborescence affairef-
Q.S.E"

Dim Compteur, Position, Longueur, Boucle As Integer
Dim NomCourt, NomLong, NouveauNom As String

Dim f() As String
Dim oFS, oLecteur, oFichier, oFolder
Dim varListeNbr As Long

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder(cteDossier)

Application.ScreenUpdating = False
ChDir cteDossier

varListeNbr = oFolder.Files.Count
Compteur = 1
If ((varListeNbr > cteMinf) And (varListeNbr <
cteMaxf))

Then
ReDim f(varListeNbr)
For Each oFichier In oFolder.Files
Position = InStr(1, oFichier.Name, ".xls",
vbTextCompare)

If (Position > 0) Then
If ((Len(oFichier.Name) - 3) = Position) Then
f(Compteur) = oFichier.Name
Compteur = (Compteur + 1)
End If
End If
Next oFichier

Longueur = Len(Range("B8").Value)
For Boucle = 1 To (Compteur - 1)
If (Mid(f(Boucle), 1, Longueur) <> Range("B8").Value)
Then

Application.DisplayAlerts = False
NomCourt = f(Boucle)
NomLong = cteDossier & "" & NomCourt
NouveauNom = cteDossier & "" & Range("B8").Value & f
(Boucle)
oFS.CopyFile NomLong, NouveauNom
Kill NomLong
Application.DisplayAlerts = True
End If
Next

End If

End Sub

@+
Michel

-----Message d'origine-----
ReBonjour MICHEL
Apparemment les 2 tentatives de réponses au fil
précédent

que j'ai faites ne sont pas passées
Le prefixe à inscrire est défini par B8
Le prefixe à exclure aussi, au cas improbable ou il
aurait

deja été mis
En fait le projet que je propose aux utilisateurs est
le

suivant :
Je crée un repertoire, et des s/rep
Je copie dans un de ces s/rep ,des fichiers (env une
quinzaine)provenant d'un autre lecteur
J'ouvre ces fichiers
Je copie la page ou se situe la macro sur la première
page

de ces fichiers (ça ne marche pas pour l'instant)
Je sauvegarde ces fichiers et les ferme
Je renomme les fichiers
Je renomme le rep principal

Donc il n'ya pas de chance qu'ils soient deja nommés
Sinon , j'ai tasté le code XLS que tu as conçu. C'est
du

beau travail
Par contre, il semble que les fichiers originaux ne
soient

pas détruits (normal ?)

Merci encore
A+
gilles

.

.

.

.

Salut gilles,

J'ai testé avec les noms de fichiers que tu m'as fournit
et le tout fonctionne très bien. Or il me vient une idée!

Quels sont les macros complémentaires que tu as de
chargés,
et de même, quelles sont les références chargés.

Sous Excel :

//Ouitls/Macro Complémentaires...

Ici, j'ai chargés:
"Utilitaires d'Analyse"
"Utilitaires d'Analyse - VBA"


[Alt F11] //Outils/Références...

Ici, j'ai chargés:

"Visual Basic for Applications"
"Microsoft Excel 9.0 Object Library"
"OLE Automation"
"Microsoft Office 9.0 Object Library"

Bon, au cas ou ?

@+
Michel

-----Message d'origine-----
bonjour MICHEL
merci de suivre mes balbutiements!
j'admire ton côté serviable
ci-joint 4 noms de fichiers utilisés

budget 1er juillet 2004
Etiquettes dossiers affaires
FNCreprise
plan de controles et convocations

Je ne voudrais pas abuser de ton temps,mais si tu vois
kekchose, je t'en remercie
à+
gilles

-----Message d'origine-----
Bonjour gilles,

Pour tout les tests que j'ai fait à la maison en cours
de développement, le fichier se trouvait sur le lecteur
"E" et j'ai créer le même chemin sur le "C".

Peut-être que : les noms de fichiers sont en cause !

Peux-tu me donner un exemple de nom de fichier que
tu tests. J'éffecturai le même test !

P.S. J'en suis à la version 1.2.0 sur l'adresse que
je t'ai donné dans l'autre "post" qui est plein.

Michel B.

-----Message d'origine-----
re-bonjour MICHEL
après test
le code renomme 4 fichier sur 8 puis met le message
erreur75 définie par le chemin
2 autres tentatives avec la meme effet mais un nbre de
renommage différent (3 puis 2)
Le code est dans un fichier sur le lecteur d
les fichiers sont sur un rep du C
cela peut il avoir un lien?
MERCI encore
à+
gilles

-----Message d'origine-----
Bonjour gilles,

Chez moi, l'appli fonctionne correctement. Ceci dit
pour te facilter la tâche, j'ai retravaillé le code
original que j'inclus ici, toutefois je continue vers
ma lancer pour créer une application robuste.

Voici donc ce que ça donne, tu y trouveras peut-être
ton bonheur.

Sub prefic082()

Const cteMaxf = 30000
Const cteMinf = 1

Const cteDossier = "C:Q.S.E3arborescence affairef-
Q.S.E"

Dim Compteur, Position, Longueur, Boucle As Integer
Dim NomCourt, NomLong, NouveauNom As String

Dim f() As String
Dim oFS, oLecteur, oFichier, oFolder
Dim varListeNbr As Long

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder(cteDossier)

Application.ScreenUpdating = False
ChDir cteDossier

varListeNbr = oFolder.Files.Count
Compteur = 1
If ((varListeNbr > cteMinf) And (varListeNbr <
cteMaxf))

Then
ReDim f(varListeNbr)
For Each oFichier In oFolder.Files
Position = InStr(1, oFichier.Name, ".xls",
vbTextCompare)

If (Position > 0) Then
If ((Len(oFichier.Name) - 3) = Position) Then
f(Compteur) = oFichier.Name
Compteur = (Compteur + 1)
End If
End If
Next oFichier

Longueur = Len(Range("B8").Value)
For Boucle = 1 To (Compteur - 1)
If (Mid(f(Boucle), 1, Longueur) <> Range("B8").Value)
Then

Application.DisplayAlerts = False
NomCourt = f(Boucle)
NomLong = cteDossier & "" & NomCourt
NouveauNom = cteDossier & "" & Range("B8").Value & f
(Boucle)
oFS.CopyFile NomLong, NouveauNom
Kill NomLong
Application.DisplayAlerts = True
End If
Next

End If

End Sub

@+
Michel

-----Message d'origine-----
ReBonjour MICHEL
Apparemment les 2 tentatives de réponses au fil
précédent

que j'ai faites ne sont pas passées
Le prefixe à inscrire est défini par B8
Le prefixe à exclure aussi, au cas improbable ou il
aurait

deja été mis
En fait le projet que je propose aux utilisateurs
est

le

suivant :
Je crée un repertoire, et des s/rep
Je copie dans un de ces s/rep ,des fichiers (env une
quinzaine)provenant d'un autre lecteur
J'ouvre ces fichiers
Je copie la page ou se situe la macro sur la première
page

de ces fichiers (ça ne marche pas pour l'instant)
Je sauvegarde ces fichiers et les ferme
Je renomme les fichiers
Je renomme le rep principal

Donc il n'ya pas de chance qu'ils soient deja nommés
Sinon , j'ai tasté le code XLS que tu as conçu. C'est
du

beau travail
Par contre, il semble que les fichiers originaux ne
soient

pas détruits (normal ?)

Merci encore
A+
gilles

.

.

.

.

.

bonsoir MICHEL
Là , tu touches peut-être un point clef, car je n'ai
jamais chargé de macro complémentaire
En fait les macros que j'utilise doivent pouvoir
fonctionner sur les postes des collègues qui les
utiliseront, et dont certains sont en xl97
d'ailleurs, je suis souvent confronté à ce pb: je crée
des fichiers comportant des macros sur mon PC en xlxp et
lorsque je les mets en réseau, sur XL97 ça plante
je vais réssayer avec le dernier de tes envois (tu vas
plus vite à les concevoir que moi à les exploiter!
à+et merci
gilles

-----Message d'origine-----
Salut gilles,

J'ai testé avec les noms de fichiers que tu m'as fournit
et le tout fonctionne très bien. Or il me vient une
idée!

Quels sont les macros complémentaires que tu as de
chargés,
et de même, quelles sont les références chargés.

Sous Excel :

//Ouitls/Macro Complémentaires...

Ici, j'ai chargés:
"Utilitaires d'Analyse"
"Utilitaires d'Analyse - VBA"


[Alt F11] //Outils/Références...

Ici, j'ai chargés:

"Visual Basic for Applications"
"Microsoft Excel 9.0 Object Library"
"OLE Automation"
"Microsoft Office 9.0 Object Library"

Bon, au cas ou ?

@+
Michel

-----Message d'origine-----
bonjour MICHEL
merci de suivre mes balbutiements!
j'admire ton côté serviable
ci-joint 4 noms de fichiers utilisés

budget 1er juillet 2004
Etiquettes dossiers affaires
FNCreprise
plan de controles et convocations

Je ne voudrais pas abuser de ton temps,mais si tu vois
kekchose, je t'en remercie
à+
gilles

-----Message d'origine-----
Bonjour gilles,

Pour tout les tests que j'ai fait à la maison en cours
de développement, le fichier se trouvait sur le
lecteur

"E" et j'ai créer le même chemin sur le "C".

Peut-être que : les noms de fichiers sont en cause !

Peux-tu me donner un exemple de nom de fichier que
tu tests. J'éffecturai le même test !

P.S. J'en suis à la version 1.2.0 sur l'adresse que
je t'ai donné dans l'autre "post" qui est plein.

Michel B.

-----Message d'origine-----
re-bonjour MICHEL
après test
le code renomme 4 fichier sur 8 puis met le message
erreur75 définie par le chemin
2 autres tentatives avec la meme effet mais un nbre
de

renommage différent (3 puis 2)
Le code est dans un fichier sur le lecteur d
les fichiers sont sur un rep du C
cela peut il avoir un lien?
MERCI encore
à+
gilles

-----Message d'origine-----
Bonjour gilles,

Chez moi, l'appli fonctionne correctement. Ceci dit
pour te facilter la tâche, j'ai retravaillé le code
original que j'inclus ici, toutefois je continue
vers

ma lancer pour créer une application robuste.

Voici donc ce que ça donne, tu y trouveras peut-être
ton bonheur.

Sub prefic082()

Const cteMaxf = 30000
Const cteMinf = 1

Const cteDossier = "C:Q.S.E3arborescence affairef-
Q.S.E"

Dim Compteur, Position, Longueur, Boucle As Integer
Dim NomCourt, NomLong, NouveauNom As String

Dim f() As String
Dim oFS, oLecteur, oFichier, oFolder
Dim varListeNbr As Long

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder(cteDossier)

Application.ScreenUpdating = False
ChDir cteDossier

varListeNbr = oFolder.Files.Count
Compteur = 1
If ((varListeNbr > cteMinf) And (varListeNbr <
cteMaxf))

Then
ReDim f(varListeNbr)
For Each oFichier In oFolder.Files
Position = InStr(1, oFichier.Name, ".xls",
vbTextCompare)

If (Position > 0) Then
If ((Len(oFichier.Name) - 3) = Position) Then
f(Compteur) = oFichier.Name
Compteur = (Compteur + 1)
End If
End If
Next oFichier

Longueur = Len(Range("B8").Value)
For Boucle = 1 To (Compteur - 1)
If (Mid(f(Boucle), 1, Longueur) <> Range
("B8").Value)

Then

Application.DisplayAlerts = False
NomCourt = f(Boucle)
NomLong = cteDossier & "" & NomCourt
NouveauNom = cteDossier & "" & Range("B8").Value & f
(Boucle)
oFS.CopyFile NomLong, NouveauNom
Kill NomLong
Application.DisplayAlerts = True
End If
Next

End If

End Sub

@+
Michel

-----Message d'origine-----
ReBonjour MICHEL
Apparemment les 2 tentatives de réponses au fil
précédent

que j'ai faites ne sont pas passées
Le prefixe à inscrire est défini par B8
Le prefixe à exclure aussi, au cas improbable ou il
aurait

deja été mis
En fait le projet que je propose aux utilisateurs
est

le

suivant :
Je crée un repertoire, et des s/rep
Je copie dans un de ces s/rep ,des fichiers (env
une

quinzaine)provenant d'un autre lecteur
J'ouvre ces fichiers
Je copie la page ou se situe la macro sur la
première

page

de ces fichiers (ça ne marche pas pour l'instant)
Je sauvegarde ces fichiers et les ferme
Je renomme les fichiers
Je renomme le rep principal

Donc il n'ya pas de chance qu'ils soient deja nommés
Sinon , j'ai tasté le code XLS que tu as conçu.
C'est

du

beau travail
Par contre, il semble que les fichiers originaux ne
soient

pas détruits (normal ?)

Merci encore
A+
gilles

.

.

.

.

.

.

re :

bon et bien j'en ai encore du code :-)))

voilà, j'ai développé une application que j'ai publié
sur ExcelDownLoad, elle se nomme VizioXLA.xls. Cette
utilitaire montre comment travailler avec les objets
Excel.

De plus à l'ouverture, celui-ci test la présence d'une
références et la charge si elle est absente. Ainsi même
si le classeur se déplace d'une machine à une autre, les
macros fonctionnent toujours.

ici :
http://www.excel-downloads.com/html/French/fichiers/tous-
titre_fichier-43.htm

VizioXLA.zip (Arsène Lupin)

@+
Michel

-----Message d'origine-----
bonsoir MICHEL
Là , tu touches peut-être un point clef, car je n'ai
jamais chargé de macro complémentaire
En fait les macros que j'utilise doivent pouvoir
fonctionner sur les postes des collègues qui les
utiliseront, et dont certains sont en xl97
d'ailleurs, je suis souvent confronté à ce pb: je crée
des fichiers comportant des macros sur mon PC en xlxp et
lorsque je les mets en réseau, sur XL97 ça plante
je vais réssayer avec le dernier de tes envois (tu vas
plus vite à les concevoir que moi à les exploiter!
à+et merci
gilles

-----Message d'origine-----
Salut gilles,

J'ai testé avec les noms de fichiers que tu m'as fournit
et le tout fonctionne très bien. Or il me vient une
idée!

Quels sont les macros complémentaires que tu as de
chargés,
et de même, quelles sont les références chargés.

Sous Excel :

//Ouitls/Macro Complémentaires...

Ici, j'ai chargés:
"Utilitaires d'Analyse"
"Utilitaires d'Analyse - VBA"


[Alt F11] //Outils/Références...

Ici, j'ai chargés:

"Visual Basic for Applications"
"Microsoft Excel 9.0 Object Library"
"OLE Automation"
"Microsoft Office 9.0 Object Library"

Bon, au cas ou ?

@+
Michel

-----Message d'origine-----
bonjour MICHEL
merci de suivre mes balbutiements!
j'admire ton côté serviable
ci-joint 4 noms de fichiers utilisés

budget 1er juillet 2004
Etiquettes dossiers affaires
FNCreprise
plan de controles et convocations

Je ne voudrais pas abuser de ton temps,mais si tu vois
kekchose, je t'en remercie
à+
gilles

-----Message d'origine-----
Bonjour gilles,

Pour tout les tests que j'ai fait à la maison en cours
de développement, le fichier se trouvait sur le
lecteur

"E" et j'ai créer le même chemin sur le "C".

Peut-être que : les noms de fichiers sont en cause !

Peux-tu me donner un exemple de nom de fichier que
tu tests. J'éffecturai le même test !

P.S. J'en suis à la version 1.2.0 sur l'adresse que
je t'ai donné dans l'autre "post" qui est plein.

Michel B.

-----Message d'origine-----
re-bonjour MICHEL
après test
le code renomme 4 fichier sur 8 puis met le message
erreur75 définie par le chemin
2 autres tentatives avec la meme effet mais un nbre
de

renommage différent (3 puis 2)
Le code est dans un fichier sur le lecteur d
les fichiers sont sur un rep du C
cela peut il avoir un lien?
MERCI encore
à+
gilles

-----Message d'origine-----
Bonjour gilles,

Chez moi, l'appli fonctionne correctement. Ceci dit
pour te facilter la tâche, j'ai retravaillé le code
original que j'inclus ici, toutefois je continue
vers

ma lancer pour créer une application robuste.

Voici donc ce que ça donne, tu y trouveras peut-être
ton bonheur.

Sub prefic082()

Const cteMaxf = 30000
Const cteMinf = 1

Const cteDossier = "C:Q.S.E3arborescence affairef-
Q.S.E"

Dim Compteur, Position, Longueur, Boucle As Integer
Dim NomCourt, NomLong, NouveauNom As String

Dim f() As String
Dim oFS, oLecteur, oFichier, oFolder
Dim varListeNbr As Long

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder(cteDossier)

Application.ScreenUpdating = False
ChDir cteDossier

varListeNbr = oFolder.Files.Count
Compteur = 1
If ((varListeNbr > cteMinf) And (varListeNbr <
cteMaxf))

Then
ReDim f(varListeNbr)
For Each oFichier In oFolder.Files
Position = InStr(1, oFichier.Name, ".xls",
vbTextCompare)

If (Position > 0) Then
If ((Len(oFichier.Name) - 3) = Position) Then
f(Compteur) = oFichier.Name
Compteur = (Compteur + 1)
End If
End If
Next oFichier

Longueur = Len(Range("B8").Value)
For Boucle = 1 To (Compteur - 1)
If (Mid(f(Boucle), 1, Longueur) <> Range
("B8").Value)

Then

Application.DisplayAlerts = False
NomCourt = f(Boucle)
NomLong = cteDossier & "" & NomCourt
NouveauNom = cteDossier & "" & Range("B8").Value & f
(Boucle)
oFS.CopyFile NomLong, NouveauNom
Kill NomLong
Application.DisplayAlerts = True
End If
Next

End If

End Sub

@+
Michel

-----Message d'origine-----
ReBonjour MICHEL
Apparemment les 2 tentatives de réponses au fil
précédent

que j'ai faites ne sont pas passées
Le prefixe à inscrire est défini par B8
Le prefixe à exclure aussi, au cas improbable ou il
aurait

deja été mis
En fait le projet que je propose aux utilisateurs
est

le

suivant :
Je crée un repertoire, et des s/rep
Je copie dans un de ces s/rep ,des fichiers (env
une

quinzaine)provenant d'un autre lecteur
J'ouvre ces fichiers
Je copie la page ou se situe la macro sur la
première

page

de ces fichiers (ça ne marche pas pour l'instant)
Je sauvegarde ces fichiers et les ferme
Je renomme les fichiers
Je renomme le rep principal

Donc il n'ya pas de chance qu'ils soient deja nommés
Sinon , j'ai tasté le code XLS que tu as conçu.
C'est

du

beau travail
Par contre, il semble que les fichiers originaux ne
soient

pas détruits (normal ?)

Merci encore
A+
gilles

.

.

.

.

.

.

.

bonjour MICHEL
décidément tu es impressionnant!
Tu as toujours une soluce dans une poche...!
Merci à toi de suivre le fil
J'ai donc téléchargé ton application VIZIOXLA(je te
signale,pour la forme que le fichier-43n'aboutit pas
...mais j'ai trouvé en balayant XLdownload)
Excuse mon côté ignare, mais est-ce que le code en
question est à placer dans mon fichier ?
niveau feuille ou module
ou est à placer comme macro perso?
à+
gilles

-----Message d'origine-----
re :

bon et bien j'en ai encore du code :-)))