1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
| Dim I As Integer
Dim intI As Integer
Dim A As Integer
Dim x As String
Dim y() As String
Dim z As String
' parcourir la liste pour trouver ce qui est sélectionné
For I = 0 To Me.Liste8.ListCount
' créer une lite des fichiers à transférer, séparés par ;
If Me.Liste8.Selected(I) Then x = x & "" & Me.Liste8.Column(2, I) & ";"
Next I
' créer un tableau que l'on va parcourir
y = Split(Left(x, Len(x) - 1), ";") '
' parcourir le tableau
For A = 0 To UBound(y)
'y(A) chemin complet du fichier à transférer sans les guillemets
' recherche du nom du fichier
intI = InStrRev(Chr(34) & y(A) & Chr(34), "\", -1, vbTextCompare)
z = IIf(intI = 0, Chr(34) & y(A) & Chr(34), Mid(Chr(34) & y(A) & Chr(34), intI + 1))
z = Left(z, Len(z) - 1) 'nom du fichier seul
' transfert des fichiers
Dim oFSO As Scripting.FileSystemObject
Set oFSO = New Scripting.FileSystemObject
' détermination du départ et de l'arrivée
oFSO.MoveFile y(A), Me.Texte15 & "" & Format(Date, "yyyymmdd") & " " & Me.Modifiable175.Column(0) & " " & z
'on passe à la ligne suivante du tableau
Next A
err:
msgbox err.number &" "& err.description |
Partager