Public Sub Machwas()
Dim i as Integer
Dim CurrentName as String
Dim NewName as String
 
If List1.Listcount = 0 Then Exit Sub
 
For i = 0 To List1.ListCount - 1
 CurrentName = List1.List(i)
 NewName = GetPath(CurrentName) & "\Bild " & Format(i,"000") & "." & _
   GetExtension(CurrentName)
 Msgbox "Vorher: " & CurrentName & vbNewline & "Nachher: " & NewName
Next i
 
End Sub
 
Public Function GetExtension(Filename As String) As String
 GetExtension = LCase(Right(Filename, Len(Filename) - InStrRev(Filename, ".")))
End Function
 
Public Function GetPath(File As String) As String
 If Instr(1,File,"\") = 0 Then Exit Function
 GetPath = Left(File, InStrRev(File, "\") - 1)
End Function