Numerazione progressiva di Files in una determinata cartella.

Ciao Nicola,

Per motivi diagnostici, prova a eseguire il seguente adattamento del mio codice:

'==========>>

Option Explicit

'--------->>

Public Sub RenameFiles()

    Dim vPath As Variant, vFirstNumber As Variant, vPrefix As Variant

    Dim sMsg As String, sTitle As String

    Dim iButtons As Long

    Dim sStr As String

    sStr = Application.PathSeparator

    vPath = Application.InputBox(Prompt:="Inserisci il percorso della cartella " _

                                       & "dei file da rinominare," _

                                       & " ad esempio: ABC", _

                                 Title:="PERCORSO DI CARTELLA", _

                                 Default:="C:\Users\Nicola2", _

                                 Type:=2)

    If vPath = "False" Or vPath = vbNullString Then

        sMsg = "Non hai fornito un percorso - Ripova!"

        iButtons = vbCritical

        sTitle = "ERRORE - PERCORSO MANCANTE"

        GoTo XIT

    End If

    If Right(vPath, 1) <> sStr Then

        vPath = vPath & sStr

    End If

    vFirstNumber = Application.InputBox(Prompt:="Inserisci il Numero di partenza", _

                                        Title:="NUMERAZIONE PROGRESSIVA DEI FILES", _

                                        Default:=1, _

                                        Type:=1)

    If vFirstNumber = "False" Then

        sMsg = "Non hai fornito un numero iniziale - Ripova!"

        iButtons = vbCritical

        sTitle = "ERRORE - RIPPROVA"

        GoTo XIT

    End If

    vPrefix = Application.InputBox(Prompt:="Inserisci un prefisso per i file," _

                                         & " ad esempio: ABC", _

                                   Title:="PREFISSO OPZIONALE", _

                                   Default:="", _

                                   Type:=2)

    Call RenominaFilePogressivamente(vPath, vFirstNumber, vPrefix)

    Exit Sub

XIT:

    Call MsgBox(Prompt:=sMsg, Buttons:=iButtons, Title:=sTitle)

End Sub

'--------->>

Public Function RenominaFilePogressivamente(myFolderPath, _

                                            Optional FirstNumber = 1, _

                                            Optional sPrefix)

    Dim oFSO As Object

    Dim oFolder As Object

    Dim oFiles As Object

    Dim oFile As Object

    Dim iCtr As Long, jCtr As Long, iPos As Long

    Dim sStr As String, aStr As String, sExt As String

    Dim oldName As String

    Dim V As Variant

    Dim sMsg As String, sTitle As String

    Dim iButtons As Long

    Dim arrOther() As Variant

    Set oFSO = CreateObject("Scripting.FileSystemObject")

    Set oFolder = oFSO.GetFolder(myFolderPath)

    Set oFiles = oFolder.Files

    For Each oFile In oFiles

        With oFile

            oldName = .Name

            iPos = InStrRev(.Name, ".")

            sExt = Right(.Name, Len(.Name) - iPos + 1)

            If UCase(sExt) = ".PDF" Then

                .Name = sPrefix & FirstNumber + iCtr & sExt

                iCtr = iCtr + 1

                Debug.Print iCtr & vbTab; "Old: " & oldName; vbTab _

                          & "New: " & oFile.Name

        Else

            jCtr = jCtr + 1

            ReDim Preserve arrOther(1 To jCtr)

            arrOther(jCtr) = .Name

        End If

        End With

    Next oFile

    sMsg = "Sono stati rinominati: " _

         & iCtr & " Files!"

    iButtons = vbInformation

    sTitle = "# FILE RINOMINATI"

XIT:

    Call MsgBox(Prompt:=sMsg, Buttons:=iButtons, Title:=sTitle)

    If CBool(jCtr) Then

        aStr = Join(arrOther, vbNewLine)

        sMsg = "I seguenti " & jCtr & "file non pdf sono stato trovati:" _

             & vbNewLine & vbNewLine & aStr

         Call MsgBox(sMsg, vbInformation, "FILE NON PDF")

    End If

End Function

'<<=========

Ho cominciato con questa cartella C:\Users\Nicola2\

Ho eseguito il codice, scegliendo 1 come primo numero e AAA come prefisso. Ho ricevuto i due messagi:

e

Nella finestra Immediate vedo

Poi, riguardando la cartella, vedo:

Postscriptum:

Quando ho inviato questa risposta, non vedevo la risposta precedente di Mauro.

===

Regards,

Norman

Neppure io.

A me il codice di Norman funziona tranquillamente.

Sicuro che nella cartella ci siano SOLO i file che credi/vedi?

Rifai la cartella nuova. Copiaci i file e fai girare questa macro (modifica la parte in grassetto con il tuo riferimento):

Public Sub m()

    Dim objFSO As Object

    Dim objFolder As Object

    Dim objFile As Object

    Dim sPath As String

    Dim lCont As Long

    Dim lCount As Long

    lCont = 0

    sPath = "**C:\TestPDF**"

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set objFolder = objFSO.GetFolder(sPath)

    lCount = objFolder.Files.Count

    For Each objFile In objFolder.Files

        If Right(objFile.Name, 4) = ".pdf" Then

            lCont = lCont + 1

        End If

    Next

    MsgBox "Fle totali: " & lCount & _

        vbNewLine & "File .pdf: " & lCont

RigaChiusura:

    Set objFile = Nothing

    Set objFolder = Nothing

    Set objFSO = Nothing

    Exit Sub

End Sub

Questa invece ti restituisce, sempre prima della trasformazione del nome, eventuali file non .pdf:

Public Sub m()

    Dim objFSO As Object

    Dim objFolder As Object

    Dim objFile As Object

    Dim sPath As String

    Dim lCont As Long

    Dim s As String

    sPath = "**C:\TestPDF**"

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set objFolder = objFSO.GetFolder(sPath)

    For Each objFile In objFolder.Files

        If Right(objFile.Name, 4) <> ".pdf" Then

            lCont = lCont + 1

            s = s & objFile.Name & vbNewLine

        End If

    Next

    MsgBox "Fle non .pdf: " & lCont & vbNewLine & s

RigaChiusura:

    Set objFile = Nothing

    Set objFolder = Nothing

    Set objFSO = Nothing

    Exit Sub

End Sub

Ovviamente dovresti sapere a priori quanti file ci sono nella cartella per confrontarli con il MsgBox.