Voila mes modifs ... moi je suis plutot Java, donc VBA je connais pas et j'ai fait ça à l'arrache, donc c'est pas très beau mais ça marche.
Sinon, j'ai quand même envoyé un commentaire à Kodak, parce que faut pas déconner non plus, même pas de lecture aléatoire dans un cadre photo numérique, c'est franchement n'importe quoi
Encore merci
Private Sub CommandButton1_Click()
Set fs = Application.FileSearch
dossier = "d:\temp\copytest\src\"
dossierarr = "d:\temp\copytest\dst\"
fichs = "*.jpg"
Loogu = Len(dossier)
With fs
.LookIn = dossier
.Filename = fichs
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
Range("a:a" ).Select
Selection.ClearContents
For i = 1 To .FoundFiles.Count
' y avait un petit bug dans le substring qui tronquait le premier caractere du nom
fname = Mid(.FoundFiles(i), Loogu + 1, Len(.FoundFiles(i)) - Len(Loogu))
Cells(i, 1) = fname
Next i
Else
MsgBox "There were no files found."
End If
End With
upperbo = Sheets("First" ).Cells(65527, 1).End(xlUp).Row
lowerbound = 1
For i = 1 To upperbo
upperbound = Sheets("First" ).Cells(65527, 1).End(xlUp).Row
lili = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
Cells(i, 2) = Cells(lili, 1)
Cells(lili, 1).Select
Selection.Delete shift:=xlUp
Next i
Range("a:a" ).Select
Selection.Delete shift:=xlLeft
dossierdep = dossier & "\"
' je supprime l effacement de la destination, ca plante quand c est vide et je sais pas l empecher
' Kill dossierarr & "*.jpg"
For i = 1 To upperbo
' je rajoute des 0 pour conserver l ordre lexicograhique. C est fait de manière degueu mais je connais pas VBA
prefix = "a"
If i < 1000 Then
prefix = prefix & "0"
End If
If i < 100 Then
prefix = prefix & "0"
End If
If i < 10 Then
prefix = prefix & "0"
End If
fichacop = dossierdep & Cells(i, 1)
fichar = dossierarr & prefix & i & "_" & Cells(i, 1)
'fichar = dossierarr & Cells(i, 1)
FileCopy fichacop, fichar
Next i
End Sub
Message édité par Gonzoide le 20-07-2007 à 11:24:08