Numerazione progressiva di Files in una determinata cartella.

Anonimo

Buona domenica a tutti, ho messo su questo codice che mi numera in progressione dei files in una determinata cartella.

Il problema che la numerazione è sballata cois come da immagine allegata.

Dopo il file nr 19 dovrebbe venire il file nr 20 invece il file è 110.

Mi aiutate a capire perchè la numeraione non è consecutiva?

Sub rinomina()

Dim NomeFiglio, NomeEstensione, Cartella, Conta

Dim v As String

v = Application.InputBox("Inserisci il Numero di partenza", "NUMERAZIONE PROGRESSIVA DEI FILES")

Cartella = "C:\Users\Nicola\Desktop\Nuova cartella"

NomeFiglio = Dir(Cartella, vbDirectory)

Conta = 0

Do While NomeFiglio <> ""

If (GetAttr(Cartella & NomeFiglio) And vbDirectory) <> vbDirectory Then

NomeEstensione = Right(NomeFiglio, Len(NomeFiglio) - InStrRev(NomeFiglio, ".") + 1)

Name Cartella & NomeFiglio As Cartella & Format(Conta, v) & NomeEstensione

Conta = Conta + 1

End If

NomeFiglio = Dir

Loop

MsgBox "Sono stati rinominati: " & Conta & " Files!", vbInformation

End Sub

Ciao Nicola.

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

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:

Nella finestra Immediate vedo

Poi, riguardando la cartella, vedo:

Postscriptum:

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

===

Regards,

Norman

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

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

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

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.

0 commenti

12 risposte aggiuntive

Anonimo

2015-10-25T18:59:28+00:00

Ciao Mauro, grazie infinte per la spiegazione molto professionale ed esaustiva.

Ciao Norman, è vero quando rinominavo i files questi non ripartivano mai dal numero impostato nella InputBox ma si aggiungeva altra numerazione e cosi che ottenevo una numerazione confusa e sbagliata.

Comunque ho notato che mi conta 31 files anziché 30(sono 30 quelli realmente presenti nella cartella), perchè questo Norman?

Ciao Nicola.
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-10-25T18:06:24+00:00

Ciao Nicola,

Oltre alla risposta di Mauro, credo ci sono diverse problemi con tuo uso della funzione Dir(). Non meno di questi sarebbe il fatto che, come scritto, il tuo codice potrebbe, durante lo stesso ciclo di esecuzione della macro, rinomina un file precedentemente rinominato. In questo modo ci potrebbero essere delle lacune nella numerazione. Inoltre, il codice domanda che l'utente fornisca un numero iniziale, ma poi non utilizza mai quel numero iniziale!

Prova quindi qualcosa del genere:

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

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) 'Desktop\Nuova cartella", _

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, iPos As Long

Dim sStr As String, sExt As String

Dim V As Variant

Dim sMsg As String, sTitle As String

Dim iButtons As Long

Const sCartella As String = "C:\Users\Nicola2" 'Desktop\Nuova cartella"

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFSO.GetFolder(myFolderPath)

Set oFiles = oFolder.Files

For Each oFile In oFiles

With oFile

iPos = InStrRev(.Name, ".")

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

.Name = sPrefix & FirstNumber + iCtr & sExt

End With

iCtr = iCtr + 1

Next oFile

sMsg = "Sono stati rinominati: " _

& iCtr & " Files!"

iButtons = vbInformation

sTitle = "# FILE RINOMINATI"

XIT:

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

End Function

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

Nota che solo la procedura RenameFiles viene eseguita dall'utente anche se il vero lavoro sia effetuata dalla funzione RenominaFilePogressivamente

Perché hai già rinominato i file, ogni tentativo di rinominarli con un numero di sequenza di sovrapposizione causerà errori. Per evitare questo problema, rinominarli prima con un'altra sequenza numerica, ad esempio a partire da 5000 e poi ripetere la macro utilizzando 1 come il primo numero.

Nota che il codice consente anche di aggiungere opzionalmente un prefisso per la nuova sequenza numerica.

===

Regards,

Norman
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-10-25T16:56:28+00:00

Non è *sballata* è corretta.

I nomi dei file sono testo, NON numeri. Quindi come testo binario sono ordinati correttamente.

Devi salvarli così fino a 999: 001, 002, ..... 999.

Se sono più di 999: 0001, 0002, ..... 9999

Se sono più di 9999: 00001, ecc.

L'ordine che vedi (e che vediamo noi nell'immagine che hai postato) è relativo a testo.

Se non sai come ottenere quei *numeri* (testo) vedi qui sotto un piccolo esempio:

Public Sub m()

    Dim lng As Long

    Dim s As String

    For lng = 1 To 10

        s = s & "Ciao " & Format(lng, "0000") & vbNewLine

    Next

    MsgBox s

End Sub

Che da come risultato:
La risposta è stata utile?

0 commenti Nessun commento