[VB.NET -> VBA]Renomer fichiers (comme W7) en VBA [Résolu]

- - Dernière réponse :  Scarbiet94 - 16 mai 2013 à 18:13
Bonjour à tous,

Avant de m'attaquer à une macro qui ne me semble pas simple, je parcours les forums pour apprendre le VBA. Pour finir une macro "d'essai" qui lit les dimensions de fichiers image pour les placer en début de nom, je n'arrive pas à terminer la partie qui consiste à renommer un fichier existant comme le fait Window 7 : nom(1).jpg, nom(2) .jpg, nom(3). .jpg...

J'ai une erreur d’exécution 5 qui se produit à la ligne St = Dir.

Sub Teste_Si_Fichier_Existe_Et_Renome()
Dim NouveauNom, Ext, Su, Ajout As String
Dim Repertoire As String
Dim Fso As Object
Dim Pos, Nbre, Pos1, Pos2, LenEntier As Integer
Dim CasParticulier As Boolean
Dim St As String
Dim Fichier As String
 
'Choix du répertoire
Repertoire = ChoixRepertoire & ""
 
'première entrée fichier
Fichier = Dir(Repertoire, vbNormal Or vbHidden)
 
' recherche l'extension pour les fichiers qui contiennent
' un ou plusieurs points dans leur nom : 1.5.jpg, nom.suit.1.xls
Ext = Extension(Fichier)
 
Set Fso = CreateObject("Scripting.FileSystemObject")
St = Repertoire & Fichier
 
Ajout = "(1)" 'renomme avec (1)° par défaut
CasParticulier = True
 
While Dir(St) <> ""
    While Fichier_Existe(St)
        'Recherche le fichiers se terminant par (n)
        Pos = InStr(Fichier, ").")
        If Pos <> 0 And CasParticulier Then
            Pos2 = InStr(Fichier, "(")
            LenEntier = Pos - Pos2 - 1
            Su = Mid(Fichier, Pos2 + 1, LenEntier)
            If IsNumeric(Su) And Pos2 >= 2 Then
                Nbre = CInt(Su)
                Nbre = Nbre + 1
                Ajout = "(" & Trim(Str(Nbre)) & ")"
                Pos = Len(Fichier) - (Len(Ext) + LenEntier + 2)
                NouveauNom = Left(Fichier, Pos) & Ajout & Ext
            Else
                'le nom du fichier se termine par une parenthèse
                ' non précédée par un nombre entier
                NouveauNom = Left(Fichier, InStr(Fichier, Ext) - 1) & Ajout & Ext
                CasParticulier = False
            End If
        Else
            NouveauNom = Left(Fichier, InStr(Fichier, Ext) - 1) & Ajout & Ext
        End If
        NouveauNom = Trim(NouveauNom)
        Fso.MoveFile Fichier, NouveauNom
    Wend
St = Dir
Wend
 
End Sub


Merci par avance, je sèche.
Question très subsidiaire. Je m’aperçois que la recherche de la parenthèse ouverte ne permet pas d'obtenir 1(a).jpg puis 1(a)(1).jpg

PS Je me suis basé sur la procédure suivante qui fonctionne

[code]
Sub Liste_Fichiers_jpg()
Dim Filtre As String, Fichiers As String, Nomm As String
On Error Resume Next
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choisir un dossier..........."
.Show
If .SelectedItems.Count > 0 Then
NomDossier = .SelectedItems(1) & ""
End If
End With
Filtre = "*.jpg"
Fichiers = Dir(NomDossier & "" & Filtre, vbNormal Or vbHidden)

While Fichiers <> ""
Nomm = Left(Fichiers, Len(Fichiers) - 4)
Fichiers = Dir
Wend
End Sub
[code]
Afficher la suite 

3/23 réponses

0
Merci
Suite

J'ai essayé avec une autre fonction qui teste l'existence d'un fichier dans recourir à la fonction Dir
Function FichierExiste(Fich As String) As Boolean
Dim Teste As Object
    Set Teste = CreateObject("Scripting.FileSystemObject")
    FichierExiste = Teste.FileExists(Repertoire & Fich)
    Set Teste = Nothing
End Function

L'erreur se produit au même endroit. Pour que çà fonctionne je détermine le nombre de fichiers dans le répertoire. Quant le nombre est atteint, je fais un Goto fin de procédure pour sortir de la boucle For Each Fichier. Ca marche, mais ce n'est pas satisfaisant. SI quelqu'un a une idée...
Commenter la réponse de Scarbiet94
0
Merci
Bonjour,

Goto fin de procédure pour sortir de la boucle For Each Fichier
SI quelqu'un a une idée...


Pourquoi pas juste un exit for ?
Commenter la réponse de Utilisateur anonyme
0
Merci
Bonjour,

Exact, mais j'ai toujours "peur" d'utiliser Exit car c'est associé à Exit Sub, mais je vais m'y faire.

En cherchant dans les propriétés de "Scripting.FileSystemObject", j'ai trouvé un moyen de sortir de la procédure en cours pour tester si un fichier existe(et ça a l'avantage d'être court). Si ça t'intéresse
While FSO.FileExists(St)

(SFO est définit au dessus);

Le "bug" se produit toujours au même endroit et pour le même type de numérotation de fichier (cf. post du 15 mai). Si tu as une idée, n'hésite pas. J'ai du faire près d'un centaine de pas pas (F8, F9...)
Commenter la réponse de Scarbiet94