Coppy 2 file tới 2 folder khác nhau....!!!

Liên hệ QC
A

alias1313

Thành viên hoạt động
Tham gia
7/4/17
Bài viết
163
Được thích
13
Làm sao coppy được 2 file các Anh....
C:\file1 to C:\folfer1
C:\file2 to C:\folfer2
Mong Các anh giúp em với....

Code này em coppy 1 file thì chạy ngon
Còn muon coppy 2 file tới 2 đích khác nhau, không biết làm thế nào
Em tìm mãi không thấy chỗ nào có

Mã: 
Sub Copy_Certain_Files_In_Folder()


    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String

    FromPath = "C:\"  '<< Change
    ToPath1 = "C:\TaiLieu1\"   '<< Change
    ToPath2 = "C:\DuLieu1\"   '<< Change

    FileExt1 = "abc.xlsx"  '<< Change
    FileExt2 = "bd.xlsx"
    

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath1) = False Then
        MsgBox ToPath & " doesn't exist"
                
        Exit Sub
        
    End If

     FSO.copyfile Source:=FromPath & FileExt1, Destination:=ToPath1
     FSO.copyfile Source:=FromPath & FileExt2, Destination:=ToPath2
    MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub
 
alias1313 đã viết:
Làm sao coppy được 2 file các Anh....
C:\file1 to C:\folfer1
C:\file2 to C:\folfer2
Mong Các anh giúp em với....

Code này em coppy 1 file thì chạy ngon
Còn muon coppy 2 file tới 2 đích khác nhau, không biết làm thế nào
Em tìm mãi không thấy chỗ nào có

Mã: 
Sub Copy_Certain_Files_In_Folder()


    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String

    FromPath = "C:\"  '<< Change
    ToPath1 = "C:\TaiLieu1\"   '<< Change
    ToPath2 = "C:\DuLieu1\"   '<< Change

    FileExt1 = "abc.xlsx"  '<< Change
    FileExt2 = "bd.xlsx"
  

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath1) = False Then
        MsgBox ToPath & " doesn't exist"
              
        Exit Sub
      
    End If

     FSO.copyfile Source:=FromPath & FileExt1, Destination:=ToPath1
     FSO.copyfile Source:=FromPath & FileExt2, Destination:=ToPath2
    MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub
Nhấp chuột vào đây để mở rộng...
bạn thử vầy Xem sao...Tùy chỉnh lại Đường dẫn File va Folder lưu File
PHP: 
Public Sub CopyFiles()
    Dim Folder1 As String, Folder2 As String
    Dim Fso As Object, File1, File2
    File1 = ThisWorkbook.Path & "\1.txt" ''thay doi lai cai nay
    File2 = ThisWorkbook.Path & "\2.txt"
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Folder1 = "D:\11\" ''thay doi lai cai nay
    Folder2 = "D:\22\"
    If Fso.FileExists(File1) Then Fso.CopyFile File1, Folder1
    If Fso.FileExists(File2) Then Fso.CopyFile File2, Folder2
End Sub
 
kieu manh đã viết:
bạn thử vầy Xem sao...Tùy chỉnh lại Đường dẫn File va Folder lưu File
PHP: 
Public Sub CopyFiles()
    Dim Folder1 As String, Folder2 As String
    Dim Fso As Object, File1, File2
    File1 = ThisWorkbook.Path & "\1.txt" ''thay doi lai cai nay
    File2 = ThisWorkbook.Path & "\2.txt"
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Folder1 = "D:\11\" ''thay doi lai cai nay
    Folder2 = "D:\22\"
    If Fso.FileExists(File1) Then Fso.CopyFile File1, Folder1
    If Fso.FileExists(File2) Then Fso.CopyFile File2, Folder2
End Sub
Nhấp chuột vào đây để mở rộng...



Em đã thử cách của Anh ..nhưng cũng không được, chỉ coppy được 1 file

Mã: 
Sub Copy_Certain_Files_In_Folder()

    Dim Fso As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
    
    FromPath = "C:\"  '<< Change
    ToPath1 = "C:\TaiLieuTK\CongTacNgay\Thang 05-2017\Bao cao nhanh thong so cac to may-PM4\"   '<< Change
    ToPath2 = "C:\TaiLieuTK\CongTacNgay\Thang 05-2017\CHI SO CONG TO CAC ÐD PM1 & PM4\"   '<< Change

    FileExt1 = "abc.xlsx"   '<< Change
    FileExt2 = "bd.xlsx"
    'You can use *.* for all files or *.doc for Word files

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set Fso = CreateObject("scripting.filesystemobject")
    

    If Fso.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If
  
    If Fso.FolderExists(ToPath1) = False Then
        MsgBox ToPath & " doesn't exist"
                
        Exit Sub
    End If
    If Fso.FileExists(FromPath & FileExt1) Then
        Fso.copyfile Source:=FromPath & FileExt1, Destination:=ToPath1
    'End If
    
    ElseIf Fso.FileExists(FromPath & FileExt2) Then
      
        Fso.copyfile Source:=FromPath & FileExt2, Destination:=ToPath2
    End If
     'Fso.copyfile Source:=FromPath & FileExt1, Destination:=ToPath1
     'Fso.copyfile Source:=FromPath & FileExt2, Destination:=ToPath2
    MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub

Anh xem giúp em có lỗi gì không....
 
alias1313 đã viết:
Em đã thử cách của Anh ..nhưng cũng không được, chỉ coppy được 1 file

Mã: 
Sub Copy_Certain_Files_In_Folder()

    Dim Fso As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
 
    FromPath = "C:\"  '<< Change
    ToPath1 = "C:\TaiLieuTK\CongTacNgay\Thang 05-2017\Bao cao nhanh thong so cac to may-PM4\"   '<< Change
    ToPath2 = "C:\TaiLieuTK\CongTacNgay\Thang 05-2017\CHI SO CONG TO CAC ÐD PM1 & PM4\"   '<< Change

    FileExt1 = "abc.xlsx"   '<< Change
    FileExt2 = "bd.xlsx"
    'You can use *.* for all files or *.doc for Word files

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set Fso = CreateObject("scripting.filesystemobject")
 

    If Fso.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If
 
    If Fso.FolderExists(ToPath1) = False Then
        MsgBox ToPath & " doesn't exist"
             
        Exit Sub
    End If
    If Fso.FileExists(FromPath & FileExt1) Then
        Fso.copyfile Source:=FromPath & FileExt1, Destination:=ToPath1
    'End If
 
    ElseIf Fso.FileExists(FromPath & FileExt2) Then
   
        Fso.copyfile Source:=FromPath & FileExt2, Destination:=ToPath2
    End If
     'Fso.copyfile Source:=FromPath & FileExt1, Destination:=ToPath1
     'Fso.copyfile Source:=FromPath & FileExt2, Destination:=ToPath2
    MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub

Anh xem giúp em có lỗi gì không....
Nhấp chuột vào đây để mở rộng...
Bạn thử làm 1 cái đường dẫn y trang code mình viết đó rồi chạy code xem sao...nếu chưa được nữa thì hết thuốc chữa đó
Coi lại File1, File2 Và Folder1, Folder2

Mà mấy cái Fso này copy ở GPE đầy ra đó không copy chế lại 1 tẹo xài quá ok ..code xúc tích ngắn gọn mà hay ... đi copy code của mấy tay tây ba lô nó viết lằng nhằng lắm ...nhìn code biết ở đâu liền mà ...Tui dân mê code mà coi vài lần khai báo biết tay đó mấy nick liền
 
Lần chỉnh sửa cuối:
kieu manh đã viết:
bạn thử vầy Xem sao...Tùy chỉnh lại Đường dẫn File va Folder lưu File
PHP: 
Public Sub CopyFiles()
    Dim Folder1 As String, Folder2 As String
    Dim Fso As Object, File1, File2
    File1 = ThisWorkbook.Path & "\1.txt" ''thay doi lai cai nay
    File2 = ThisWorkbook.Path & "\2.txt"
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Folder1 = "D:\11\" ''thay doi lai cai nay
    Folder2 = "D:\22\"
    If Fso.FileExists(File1) Then Fso.CopyFile File1, Folder1
    If Fso.FileExists(File2) Then Fso.CopyFile File2, Folder2
End Sub
Nhấp chuột vào đây để mở rộng...

Cuối cùng em đa...thành công
Cảm ơn anh @kieu manh ...nhìu nhìu
Nhưng em thắc mắc sao hàm If ..không cần End If cũng được..?

Code em đã test thành công:
Mã: 
Public Sub CopyFiles_2file()

    Dim Folder1 As String, Folder2 As String
    Dim Fso As Object
    Dim FromPath As String   ' o day em khai bao them Frompath2 thi bao loi ..sao vay anh
    Dim ToPath As String       ' tuong tu o day cung vay
    Dim FileExt As String       ' tuong tu o day cung vay
    
    FromPath = "C:\"
    FromPath2 = "C:\kieumanh" '<< Change
    File1 = FromPath & "abc.xlsx"  ''thay doi lai cai nay
    File2 = FromPath2 & "\bd.xlsx"
Set Fso = CreateObject("Scripting.FileSystemObject")
    Folder1 = Range("Path2").Value  '<< Change
    Folder2 = Range("Path1").Value
    If Fso.FileExists(File1) Then Fso.copyfile File1, Folder1      ' Sao If khong can ..End If cung duoc ha anh...?
    If Fso.FileExists(File2) Then Fso.copyfile File2, Folder2
    MsgBox "it's ok "
End Sub

Many ..thanks....
 
alias1313 đã viết:
Cuối cùng em đa...thành công
Cảm ơn anh @kieu manh ...nhìu nhìu
Nhưng em thắc mắc sao hàm If ..không cần End If cũng được..?

Code em đã test thành công:
Mã: 
Public Sub CopyFiles_2file()

    Dim Folder1 As String, Folder2 As String
    Dim Fso As Object
    Dim FromPath As String   ' o day em khai bao them Frompath2 thi bao loi ..sao vay anh
    Dim ToPath As String       ' tuong tu o day cung vay
    Dim FileExt As String       ' tuong tu o day cung vay
   
    FromPath = "C:\"
    FromPath2 = "C:\kieumanh" '<< Change
    File1 = FromPath & "abc.xlsx"  ''thay doi lai cai nay
    File2 = FromPath2 & "\bd.xlsx"
Set Fso = CreateObject("Scripting.FileSystemObject")
    Folder1 = Range("Path2").Value  '<< Change
    Folder2 = Range("Path1").Value
    If Fso.FileExists(File1) Then Fso.copyfile File1, Folder1      ' Sao If khong can ..End If cung duoc ha anh...?
    If Fso.FileExists(File2) Then Fso.copyfile File2, Folder2
    MsgBox "it's ok "
End Sub

Many ..thanks....
Nhấp chuột vào đây để mở rộng...
1/ Nếu If ...then ...Thì không cần End If
2/ If còn có ElseIf ...then xong End If
Nếu Viết như sau sẻ thấy End If nhưng nhìn vào code nó sẻ thấy gớm nên việt vậy cho nó Gọn ...
Tóm lại tùy sở thích cách viết của ai đó thấy dễ nhớ và hiểu là ok
PHP: 
If Fso.FileExists(File1) Then
    Fso.copyfile File1, Folder1      ' Sao If khong can ..End If cung duoc ha anh...?
End If
If Fso.FileExists(File2) Then
    Fso.copyfile File2, Folder2
End If

Bạn có thể Vào Link sau Tham khảo thêm Fso ...trang đó cơ bản nhất đó xong từ đó từ từ khai phá thêm
http://www.giaiphapexcel.com/diendan/threads/tổng-quan-về-filesystemobject.95898/
 
kieu manh đã viết:
1/ Nếu If ...then ...Thì không cần End If
2/ If còn có ElseIf ...then xong End If
Nếu Viết như sau sẻ thấy End If nhưng nhìn vào code nó sẻ thấy gớm nên việt vậy cho nó Gọn ...
Tóm lại tùy sở thích cách viết của ai đó thấy dễ nhớ và hiểu là ok
PHP: 
If Fso.FileExists(File1) Then
    Fso.copyfile File1, Folder1      ' Sao If khong can ..End If cung duoc ha anh...?
End If
If Fso.FileExists(File2) Then
    Fso.copyfile File2, Folder2
End If

Bạn có thể Vào Link sau Tham khảo thêm Fso ...trang đó cơ bản nhất đó xong từ đó từ từ khai phá thêm
http://www.giaiphapexcel.com/diendan/threads/tổng-quan-về-filesystemobject.95898/
Nhấp chuột vào đây để mở rộng...


Thanks anh!
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

H
Giúp em đặt thêm công thức cho phép năm
    • Chấp nhận
Trả lời
4
Đọc
114
Hoàng Tuấn 868
H
8
  • Question
Xin giúp: Nhóm (group data) các dòng trong bảng tính
Trả lời
10
Đọc
366
DeTong
D
pupuchcha
  • Question
Viết code để tìm xích ma, mong mọi người giúp đỡ em ạ
Trả lời
6
Đọc
213
VetMini
V
longhungvnpost
kết hợp hàm vlookup và hlookup như thế nào, giúp e với
Trả lời
4
Đọc
74
longhungvnpost
longhungvnpost
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
2
Trả lời
29
Đọc
522
Emyeuexcel
Emyeuexcel
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom