rinomina file ricorsivamente
Sam Torpedo
cartella, tutti i nomi attuali iniziano con 4 caratteri numerici e dal
quinto in poi ci sono altri caratteri alfanumerici (es. 7254-1.jpg,
7254ab.jpg, 9965-fe02.jpg, 9965df.jpg, 99653.jpg, 9965-07.jpg). Vorrei
raggruppare tutti i file che iniziano con gli stessi 4 numeri ed
aggiungere un contantore (es. 7254-01.jpg, 7254-02.jpg, 9965-01.jpg,
9965-02.jpg, 9965-03.jpg, 9965-04).
Sicuramente l'istruzione Name fa al caso, mio ma come gli dico che deve
ricominciare a rinumerare per ogni gruppo che ha lo stesso codice?
Saluti
Sam Torpedo
eSQueL
"Sam Torpedo" <fra...@gmail.com> ha scritto nel messaggio
news:1161942670.9...@m73g2000cwd.googlegroups.com...
Metti i gruppi in directory diverse e ripeti la procedura per ciascuna
directory.
Ciao.
eSQueL
Sam Torpedo
sì sarebbe stata un'ottima soluzione con pochi gruppi ma rifacendo i
calcoli i gruppi sarebbero 1340 e i file da rinominare oltre 5000!!
gasp!
--
saluti
Sam Torpedo
Roberto
2) elabori il nuovo nome con una query d'aggiornamento
3) rinomini i files leggendo la tabella
Alessandro Cara
---------------
Option Compare Database
Option Explicit
' by AlexCara
Private Items As New Collection
Function getItem(pParm As String)
Dim idx As Long
Dim oL As Variant
On Error Resume Next
idx = InStr(pParm, ".")
If pParm = "" Then
Set getItem = Items
Else
If idx = 0 Then
getItem = Items(pParm)
If Err.Number <> 0 Then
Err.Clear
Set getItem = Items(pParm)
End If
If Err.Number <> 0 Then getItem = "undefined"
Else
Set oL = Items(Left(pParm, idx - 1))
Set getItem = oL.getItem(Mid(pParm, idx + 1))
End If
End If
End Function
Sub setItem(pParm As String, pValue As Variant)
Dim idx As Long
Dim oL As Variant
On Error Resume Next
idx = InStr(pParm, ".")
If idx = 0 Then
Items.Remove (pParm)
Items.Add pValue, pParm
Else
Set oL = Items(Left(pParm, idx - 1))
If Err.Number <> 0 Then
Set oL = New cAxaSimple
setObject Left(pParm, idx - 1), oL
End If
oL.setItem Mid(pParm, idx + 1), pValue
End If
End Sub
Private Function setObject(pParm As String, pValue As Variant)
On Error Resume Next
Items.Remove (pParm)
Items.Add pValue, pParm
End Function
e funziona------------------
questo e' il codice per fare quello che vuoi (e funziona)
la funzione la ho messa in un modulo
Option Compare Database
Option Explicit
Function GetFilesOperativi(folderspec) As String
Dim fs, f, f1, fc, s
Dim oName As New cAxaSimple
Dim aName As Variant
Dim i As Long
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
i = 0
For Each f1 In fc
aName = Split(f1.Name, ".")
oName.setItem Left(aName(0), 4) & "." & aName(0), aName(0)
Next
Set s = oName.getItem("")
For Each f1 In s
Set fc = f1.getItem("")
i = 1
For Each f In fc
Debug.Print f & ".jpg", Left(f, 4) & "-" & i & ".jpg"
i = i + 1
Next
Next
End Function
NOTE:
modificare la debug.print con la istruzione di rename
se vuoi il progressivo formattato:
Debug.Print f & ".jpg", Left(f, 4) & "-" & format(i,"0000") & ".jpg"
ATTIVAZIONE:
lanciare con : GetFilesOperativi("pathinteressato")
LIMITI:
ovviamente funziona per access>97
e solo per i jpg con caratteristiche del nomefile uguale al tuo.
Per renderla "allpourposes" sono necessari un po (nel senso di fiume, in
verita' non molti) aggiustamenti.
1) gestire l'extension
2) gestire il modello del file inp/out
--
ac
Alessandro Baraldi
Alessandro Cara ha scritto:
Dim mFormat as string
Dim mExtension as variant
Property Let Formato(strIN as string)
mFormat=strIn
End Property
Property Get Formato as String
Formato=mFormat
End property
Property Let Estensioni(ParamArray Extension())
mExtension=Extension()
End Property
bla...bla...bla....
@Alex
Sam Torpedo
> questo e' il codice per fare quello che vuoi (e funziona)
FUNZIONA davvero!!
grazie Alessandro!
Ciao
--
Sam Torpedo
Alessandro Cara
> Il Sat, 28 Oct 2006 00:14:23 +0200, Alessandro Cara ha scritto:
>
>
>>questo e' il codice per fare quello che vuoi (e funziona)
>
>
> FUNZIONA davvero!!
--
ac