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

Résolu

Scarbiet94 - 1 mai 2013 à 00:50
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]

A voir également:

[VB.NET -> VBA]Renomer fichiers (comme W7) en VBA
Doevents vba - Conseils pratiques -Visual Basic / VB.NET
Byval vba - Conseils pratiques -Visual Basic / VB.NET
Aide vba - Conseils pratiques -Visual Basic / VB.NET
Commentaire en vba ✓ - Forum Visual Basic
Vba modulo - Forum Visual Basic

23 réponses

Réponse 21 / 23

Scarbiet94
15 mai 2013 à 22:36

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...

Réponse 22 / 23

Utilisateur anonyme
16 mai 2013 à 01:57

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 ?

Réponse 23 / 23

Scarbiet94
16 mai 2013 à 18:13

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...)

Discussions similaires

Comment fonctionne la fonction FormulaR1C1

fonction modulo en VBA

Dernière cellule non vide d'une colonne

A quoi sert la fonction Set ?

mettre en commentaire tout un bloc

Votre réponse

Discussions similaires