Renomer ou déplacer des fichiers

[jordi]

Pour renomer automatiquement des fichiers ou les déplacer

Code: Select all

Sub renameFiles()
Dim i As Integer, strName As String, strNewName As String, strError As String

On Error GoTo err_ScanSend
Set fs = Application.FileSearch
With fs
    .LookIn = "D:\temp\"
    .SearchSubFolders = True
    .FileName = "*"
    If .Execute > 0 Then
        For i = 1 To .FoundFiles.Count
            strName = .FoundFiles(i)
            strNewName = Replace(strName, "truc", "muche")
            Name strName As strNewName
        Next i
    End If

End With
MsgBox (strError)
Exit Sub

err_ScanSend:
    ErrNumber = Err.Number
    Select Case ErrNumber
        Case 58    ' Erreur "Ce fichier existe dj dans le rpertoire backup".
            i = i + 1
            newName = OldName & "-" & newName & "error" & i
            Resume
        Case Else
            strError = strError & Chr(13) & Chr(10) & newName
            Resume Next
    End Select
   

End Sub