Di chuyển hình ảnh có chọn lọc từ folder A sang folder B

[paulbi]

Nhờ cả nhà giúp em bài này ah:

Em có 1 folder chứa "hình ảnh" được đặt tên từ "Image 1.jpeg --> Image 100.jpeg" trong đườn dẫn: "C:\hinh anh 1"
Nhưng hiện nay em di chuyển những hình ảnh có tên chọn lọc theo list có sẵn: Image 2.jpeg, Image 4.jpeg, Image 7.jpeg....sang 1 folder có đường dẫn "C:\hinh anh 2"
Nhờ cả nhà giúp em.
Đa tạ cả nhà.

 

[leonguyenz]

Bạn tham khảo trong file đính kèm.
Code:

Sub Button2_Click()
Dim iL As String, oL As String, Lt As Range, i As Integer, c As Integer
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Lt = Sheet1.Range("C2:C" & Sheet1.Range("C65535").End(xlUp).Row)
iL = Sheet1.Range("B1"): oL = Sheet1.Range("D1")
For i = 1 To Lt.Rows.Count
    If Dir(iL & "\" & Lt(i)) <> "" Then
        c = c + 1
        Fso.Movefile iL & "\" & Lt(i), oL & "\" & Lt(i) 'Di chuyen file
        'Fso.Copyfile iL & "\" & Lt(i), oL & "\" & Lt(i) 'Copy file
    End If
Next i
If c Then
    MsgBox "Hoàn thành " & c & " file"
Else
    MsgBox "Không có file nào"
End If
End Sub

 

[paulbi]

Bạn tham khảo trong file đính kèm.
Code:

Sub Button2_Click()
Dim iL As String, oL As String, Lt As Range, i As Integer, c As Integer
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Lt = Sheet1.Range("C2:C" & Sheet1.Range("C65535").End(xlUp).Row)
iL = Sheet1.Range("B1"): oL = Sheet1.Range("D1")
For i = 1 To Lt.Rows.Count
    If Dir(iL & "\" & Lt(i)) <> "" Then
        c = c + 1
        Fso.Movefile iL & "\" & Lt(i), oL & "\" & Lt(i) 'Di chuyen file
        'Fso.Copyfile iL & "\" & Lt(i), oL & "\" & Lt(i) 'Copy file
    End If
Next i
If c Then
    MsgBox "Hoàn thành " & c & " file"
Else
    MsgBox "Không có file nào"
End If
End Sub

Cám ơn bạn để mình test thử nha

 

[paulbi]

Bạn tham khảo trong file đính kèm.
Code:

Sub Button2_Click()
Dim iL As String, oL As String, Lt As Range, i As Integer, c As Integer
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Lt = Sheet1.Range("C2:C" & Sheet1.Range("C65535").End(xlUp).Row)
iL = Sheet1.Range("B1"): oL = Sheet1.Range("D1")
For i = 1 To Lt.Rows.Count
    If Dir(iL & "\" & Lt(i)) <> "" Then
        c = c + 1
        Fso.Movefile iL & "\" & Lt(i), oL & "\" & Lt(i) 'Di chuyen file
        'Fso.Copyfile iL & "\" & Lt(i), oL & "\" & Lt(i) 'Copy file
    End If
Next i
If c Then
    MsgBox "Hoàn thành " & c & " file"
Else
    MsgBox "Không có file nào"
End If
End Sub

Đã test thử xong, thật là quá đỉnh, cám ơn bạn nhiều nha