Batch renaming af filer

Jeg kan da godt lave sådan et program - jeg smider lige en mail senere...

Jeg har lavet et foreløbigt forslag, det er sendt til dig på email - (fylder 1.5 MB, så hav lidt tålmodighed, når du henter den)

Programmet virker ved, at du vælger et dir - de filer, der bliver renamed bliver så vist i filboksen til højre. Klik >Start<, og filerne bliver renamet med fortløbende numre i alfabetisk rækkefølge.

mvh driis

Jeg ved godt at det ikke lige var hvad du bad om, men jeg blev sq lige så stolt af mig selv over at jeg kunne lave det på 40 linier vbs kode. Så hvis du kunne tænke dig et kommandointerface til din mini applikation så kopier nedenstående linier og smid dem i en fil - fx. myREN.vbs - og skriv 'cscript myREN.vbs D:\Temp ext', altså først biblioteket og dernæst den nye extension. Den er udviklet på en W2K server, så det er muligt at den ikke vil køre i dit miljø, men så glem det eller vend tilbage .... Du kan selvfølgelig nemt selv implementere min kode i vb, det ligner jo hinanden :-)

Mvh

function Usage()
    Wscript.Echo "Skriv først biblioteknavnet og dernæst den nye extension uden punktum"
    Wscript.Echo "Fx. myren.vbs D:\Temp ext"
end function

Set objArgs = WScript.Arguments
if (objArgs.count <> 2)  then
    Call Usage
    wscript.Quit(-1)
end if

strSourceFolder = objArgs(0)
strNewExt = objArgs(1)

set rs = CreateObject("adodb.recordset")
rs.Fields.Append "Filename", 200, 256   
rs.Open

set fso = CreateObject("Scripting.FileSystemObject")

set folder = fso.GetFolder(strSourceFolder)
for each file in folder.files
    rs.AddNew "Filename", file.name
next
rs.Sort = "Filename"

i = 1
rs.MoveFirst
do until rs.EOF
    strNewName = i & "." & strNewExt
    wscript.echo "Renaming " & rs("FileName") & " to " & strNewName
    fso.MoveFile strSourceFolder & "\" & rs("FileName"), strSourceFolder & "\" & strNewName
    i = i + 1
    rs.MoveNext
loop

set file = nothing
set folder = nothing
set fso = nothing
set rs = nothing

Følgende skulle kunne kopieres ind i et modul.
Men pas på! Rutinen kan lave forfærdelige ulykker hvis den bruges i et forkert dir!
Sorteringsrutine har jeg lånt fra VB source code library.


Sub SkiftFilnavne()
    Dim Fil As String
    Dim Filsti As String
    Dim strFiler() As Variant
    Dim strSorteredeFiler As Variant
    Dim strEfternavn As String
    Dim i  As Integer
    Filsti = InputBox("Indtast sti")
    If Right(Filsti, Len(Filsti)) <> "\" Then Filsti = Filsti & "\"
    strEfternavn = InputBox("Indtast efternavn (.xxx)")
    Fil = Dir(Filsti, vbNormal)
    Do While Fil <> ""  ' find filnavne
    ReDim Preserve strFiler(i)
    strFiler(i) = Fil
    Fil = Dir()
    i = i + 1
    Loop
    If i = 0 Then Exit Sub
    strSorteredeFiler = InsertSort(strFiler) 'sorter
   
    For i = 0 To UBound(strFiler)
        FileCopy Filsti & strFiler(i), Filsti & i + 1 & "." & strEfternavn
        Kill Filsti & strFiler(i)
    Next i
End Sub

'Name: InsertSort
'
' Description:
'  Sorts a single dimensional array in ascending or descending order using
'  the Insert Sorting method.
'
Function InsertSort(ValueList As Variant, Optional SortDescending As Integer) As Variant

Dim RipVal As Variant
Dim RipOrdinal As Long
Dim RipDescent As Long
Dim PrivateBuffer As Variant
Dim Placed As Boolean
Dim x As Long
Dim y As Long

PrivateBuffer = ValueList

'Ok, we start at the second position in the array and go
'from there

RipOrdinal = 1
RipDescent = 1


    For y = 1 To UBound(PrivateBuffer)
        RipVal = PrivateBuffer(y)
        If y <> 1 Then RipDescent = y
        Do Until Placed
            If IIf(SortDescending, (PrivateBuffer(RipDescent - 1) <= RipVal), _
        (PrivateBuffer(RipDescent - 1) >= RipVal)) Then

                RipDescent = RipDescent - 1
                If RipDescent = 0 Then
                    For x = y To RipDescent Step -1
                        If x = 0 Then Exit For
                        PrivateBuffer(x) = PrivateBuffer(x - 1)
                    Next x
                PrivateBuffer(RipDescent) = RipVal
                Placed = True
                End If
            Else
                'shift the array to the right
                For x = y To RipDescent Step -1
                    If x = 0 Then Exit For
                    PrivateBuffer(x) = PrivateBuffer(x - 1)
                Next x
                'insert the ripped value
                PrivateBuffer(RipDescent) = RipVal
                Placed = True
            End If
        Loop
        Placed = False
    Next y

'return the sorted array
InsertSort = PrivateBuffer


End Function

Hejsa gutter jeg er meget glad for den utrolig hurtige respons :-)

Desværre ligger landet således at mit problem er at jeg ikke er programmør, men grafiker, har dog en smule forstand på vb og asp :-) Så derfor går mit spørgsmål lidt ud på at få en færdig kompileret mini applikation ,som jeg så kan bruge.

Det er osse derfor jeg skriver at det er mod min vilje at jeg spørge efter arbejdskraft for point, da jeg selv har den holdning at man ikke bør forære sit arbejde væk og det er jo lidt det man gør da point måske ikke lige er den hårdeste valuta :-)

men tak for de gode forslag og om ikke andet kan de forhåbenlig komme en anden til gode her i gruppen :-)

Driis> jeg kigger lige nærmere på det program når jeg er færdig med at hente mailen ned :-)

osaka_san>> Min skal ikke kompileres og fylder kun 959 bytes - det må da være rekorden :-)

Baunsgaard.

hehe okay du får rekorden, men sådan en programmeringsnød som mig, skal helst have det serveret i en typisk ms vindues applikation, får jeg kan finde ud af det :-) så skidt med det fylder lidt mere, men okay du får lov til at have recorden så, men poitene gik nu alligevel til Driis fordi han var den første og fordi han kompilerede det i et lækkert lille windows program jeg kunne finde ud af *hehe* - men som sagt tidligere er jeg utrolig glad for den hurtigere respons I alle har givet :-) det vil jeg huske til næste gang jeg skal have lavet et lille program *hæhæ*

Hygge fra Oscar

Tak for pointene!

baunsgaard>> Min kode fylder heller ikke ret meget, jeg har bare kompileret det og sendt det som et Windows program.

Ahem, øh det der med programmer etc. skal vist være tilgængelige for alle eksperten brugere.

Ikke sandt Osaka_san !!!

http://www.eksperten.dk/spm/161697