Tôi có 1 Folder trong đó chứa rất nhiều folder con, trong folder còn lại chưa rất nhiều loại khác nhau (.doc, xls, flv...), giờ tôi chỉ muốn Copy (lọc) tất cả các file excel (đuôi xls, xlsx) ra thì phải làm thế nào, nhờ các thày chỉ giúp cho Code thực hiện
Bạn sử dụng code này xem sao nhé. Giả sử thư mục đích là D:\Test
Lưu ý code chỉ chạy trong excel 2003, và nếu file nào đặt tên tiếng viết có dấu cũng không copy được
PHP:
Sub Copyfile()
Application.ScreenUpdating = 0
Dim i
Dim FN As String, sFN As String
With Application.FileSearch
.SearchSubFolders = True
.LookIn = ThisWorkbook.Path
.filename = "*.xls;*.xlsx"
If .Execute() = 0 Then
End
ElseIf .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
sFN = .FoundFiles(i)
FN = Right(sFN, Len(sFN) - InStrRev(sFN, "\"))
If FN <> ThisWorkbook.Name Then
FileCopy sFN, "d:\test\" & FN
End If
Next
End If
End With
Application.ScreenUpdating = 1
End Sub
Tôi có 1 Folder trong đó chứa rất nhiều folder con, trong folder còn lại chưa rất nhiều loại khác nhau (.doc, xls, flv...), giờ tôi chỉ muốn Copy (lọc) tất cả các file excel (đuôi xls, xlsx) ra thì phải làm thế nào, nhờ các thày chỉ giúp cho Code thực hiện
Đây là 1 cách tìm files để xử lý của anh NDU rất hay, up lên để các bạn tham khảo.
Trong bài này mình đặt tên thư mục cần copy files tại ô D1, có thể điều chỉnh tùy ý
Đây là 1 cách tìm files để xử lý của anh NDU rất hay, up lên để các bạn tham khảo.
Trong bài này mình đặt tên thư mục cần copy files tại ô D1, có thể điều chỉnh tùy ý
Cũng tương tự như bài đầu của bạn. Tức sẽ bị mất tất cả các tập tin có tên tiếng Việt và tất cả các tập tin (tiếng Việt hay không) trong thư mục tên tiếng Việt. Vì tên các đường dẫn trong mảng trả về không đúng nữa nên FileCopy không thành công
Um mình cũng biết vậy nhưng khả năng chỉ có nhiêu đó nên chia sẽ bi nhiêu đó thôi. Có còn hơn không mà. Vậy theo bạn thì nên thêm bớt hay thay code nào để xử lý vấn đề trên.
Đây là 1 cách tìm files để xử lý của anh NDU rất hay, up lên để các bạn tham khảo.
Trong bài này mình đặt tên thư mục cần copy files tại ô D1, có thể điều chỉnh tùy ý
Coi chừng copy vào chung 1 thư mục sẽ có trường hợp file bị trùng tên nha (tên trùng nằm riêng không sao, cho chung lại coi chừng cái này "đè" cái kia)
Um mình cũng biết vậy nhưng khả năng chỉ có nhiêu đó nên chia sẽ bi nhiêu đó thôi. Có còn hơn không mà. Vậy theo bạn thì nên thêm bớt hay thay code nào để xử lý vấn đề trên.
code của bạn ndu đẹp rồi nên không có chuyện "thay code" ở đây. Ta chỉ cần trang điểm chút chút cho nó lộng lẫy hơn, tức hỗ trợ tiếng Việt. Ai thích tên thư mục, tên tập tin bằng tiếng Việt xin cứ mạnh dạn
Mã:
Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
Dim sComm As String, tmpFile
On Error GoTo ExitSub
If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
Folder = """" & Folder & """"
With CreateObject("Scripting.FileSystemObject")
tmpFile = .GetTempName
sComm = "DIR " & Folder & "*" & Search & "* /ON /B /A-D " & IIf(InSub, "/S", " ") & " >" & tmpFile
CreateObject("Wscript.Shell").Run "cmd /c " & sComm, 0, True
GetListFile = Split(.OpenTextFile(tmpFile, 1).ReadAll, vbCrLf)
End With
Kill tmpFile
ExitSub:
End Function
[COLOR=#0000ff]Ta sửa thành[/COLOR]
Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
Dim sComm As String, tmpFile, text As String, m() As Byte
On Error GoTo ExitSub
If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
Folder = """" & Folder & """"
With CreateObject("Scripting.FileSystemObject")
tmpFile = .GetTempName
sComm = "DIR " & Folder & "*" & Search & "* /ON /B /A-D " & IIf(InSub, "/S", " ") & " > " & tmpFile
CreateObject("Wscript.Shell").Run "cmd [COLOR=#ff0000]/U[/COLOR] /c " & sComm, 0, True
[COLOR=#ff0000]Open tmpFile For Binary As #1
ReDim m(LOF(1))
Get #1, , m
Close #1
[/COLOR]
[COLOR=#ff0000]text = m
[/COLOR] GetListFile = Split(text, vbCrLf)
End With
Kill tmpFile
ExitSub:
End Function
Và đây nữa
Mã:
Sub Get_Files()
Application.ScreenUpdating = False
On Error Resume Next
Dim arr, i, filename
arr = GetListFile(ThisWorkbook.Path, "*.xls;*xlxs", True)
For i = 0 To UBound(arr)
filename = arr(i)
filename = Right(filename, Len(filename) - InStrRev(filename, "\"))
FileCopy arr(i), [D1] & "\" & filename
Next
[a1].Resize(i - 1, 1) = Application.Transpose(arr)
Application.ScreenUpdating = True
End Sub
[COLOR=#0000ff]Ta sửa thành[/COLOR]
Sub Get_Files()
Application.ScreenUpdating = False
On Error Resume Next
Dim Arr, i, dest As String, filename As String, fso As Object
Arr = GetListFile(ThisWorkbook.Path, "*.xls;*xlxs", True)
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 0 To UBound(Arr)
filename = Arr(i)
dest = [D1] & "\" & Right(filename, Len(filename) - InStrRev(filename, "\"))
[COLOR=#ff0000]fso.CopyFile [/COLOR]filename, dest
Next
[a1].Resize(i - 1, 1) = Application.Transpose(Arr)
Application.ScreenUpdating = True
Set fso = Nothing
End Sub
Xin mời mọi người "mắt thấy tai nghe"
----------------
code đã được sửa thêm để giải quyết trường hợp không tìm thấy tập tin nào, và lược bỏ phần tử cuối cùng của mảng trả về do đó là chuỗi rỗng.
Do mảng trả về có thể chứa toàn tên tập tin chứ không phải đường dẫn đầy đủ (khi InSub = FALSE) nên Sub CopyFiles phục vụ cả trường hợp toàn tên và trường hợp là các đường dẫn đầy đủ. Ngoài ra hỗ trợ cả trường hợp các tập tin trùng tên.
code hoàn chỉnh (???) như dưới đây
Mã:
Option Explicit
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
' neu InSub = False thi mang tra ve chi chua ten cac tap tin. Neu InSub = True thi mang tra ve chua toan bo duong dan
Dim sComm As String, tmpFile, text As String, m() As Byte, Arr
On Error GoTo ExitSub
If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
Folder = """" & Folder & """"
With CreateObject("Scripting.FileSystemObject")
tmpFile = .GetTempName
sComm = "dir " & Folder & "*" & Search & "* /b " & IIf(InSub, "/s", vbNullString) & " > " & tmpFile
CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
Open tmpFile For Binary As #1
ReDim m(LOF(1))
Get #1, , m
Close #1
text = m
Arr = Split(text, vbCrLf)
' neu trong thu muc khong co tap tin nao thi UBound(Arr) = -1, ra khoi Sub
If UBound(Arr) = -1 Then GoTo ExitSub
' chac chan phan tu cuoi cung la rong, loai bo
If Arr(UBound(Arr)) = "" Then ReDim Preserve Arr(0 To UBound(Arr) - 1)
GetListFile = Arr
End With
ExitSub:
Kill tmpFile
End Function
Sub CopyFiles(Arr, ByVal srcDir As String, ByVal destDir As String)
' mang Arr co the chi chua ten chu khong phai toan bo duong dan. Neu chi chua ten
' thi ta dung srcDir de tao duong dan day du cho cac tap tin nguon
Dim k As Long, n As Long, tempArr, filename As String, src As String, fso As Object
On Error GoTo end_
If Right(destDir, 1) <> "\" Then destDir = destDir & "\"
If Right(srcDir, 1) <> "\" Then srcDir = srcDir & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
If IsArray(Arr) Then
' neu Arr la mang
tempArr = Arr
For k = LBound(tempArr) To UBound(tempArr)
src = tempArr(k)
filename = Right(src, Len(src) - InStrRev(src, "\"))
' chi co ten tap tin, ta tao duong dan day du
If filename = src Then src = srcDir & filename
' neu o dich da co tap tin ten nhu the thi ta tao ten moi bang cach them prefix
If fso.FileExists(destDir & filename) Then filename = CStr(GetTickCount) & "_" & filename
' sao tap tin toi dich
fso.CopyFile src, destDir & filename
Next k
Else
' neu Arr la 1 tap tin
src = Arr
filename = Right(src, Len(src) - InStrRev(src, "\"))
If filename = src Then src = srcDir & filename
fso.CopyFile src, destDir & filename
End If
end_:
Set fso = Nothing
End Sub
Sub Get_Files()
' vi du. Trong o D1 co thu muc dich
Application.ScreenUpdating = False
On Error Resume Next
Dim Arr
Arr = GetListFile(ThisWorkbook.path, "*.xls;*xlxs", True)
If IsArray(Arr) Then
CopyFiles Arr, ThisWorkbook.path, [D1]
[a1].Resize(UBound(Arr) + 1, 1) = Application.Transpose(Arr)
Application.ScreenUpdating = True
End If
End Sub
Đương nhiên được... nhưng code trên không chỉ có thể, nó cho phép Seach theo 1 từ khóa nào đó (chứ không riêng gì đuôi file) ---> Ví dụ Search các tên file có từ khóa *ChiThu* chẳng hạn
Toàn bộ giải thuật cho GetListFile là dùng DOS Command đấy ThuNghi à (tôi post lên diễn đàn lâu rồi mà)
Bạn siwtom cho mình hỏi thêm về tham số /U tí:
- Liệu nó có liên quan gì đến Unicode không? Vì tôi thí nghiệm thấy rằng nếu không có tham số này thì chuổi Unicode không hiển thị tốt trên file TXT
- Ngoài /U này ra, còn có những tham số nào "hay ho" nữa không?
Bạn siwtom cho mình hỏi thêm về tham số /U tí:
- Liệu nó có liên quan gì đến Unicode không? Vì tôi thí nghiệm thấy rằng nếu không có tham số này thì chuổi Unicode không hiển thị tốt trên file TXT
- Ngoài /U này ra, còn có những tham số nào "hay ho" nữa không?
Từ trước giờ tôi rất "kết" giải thuật dùng DOS Command, vì cảm giác nó cho tốc độ rất nhanh... Chỉ đáng tiếc là vẫn chưa xử lý được vụ Unicode text. Hôm nay với cái /U của bạn thì.. ngon lành rồi
Cảm ơn nhiều nhé
Ah...
Nếu là .OpenTextFile(tmpFile, 1, , -2) thì.. hình như được đấy
(đang thí nghiệm)
--------------------------
Từ trước giờ tôi rất "kết" giải thuật dùng DOS Command, vì cảm giác nó cho tốc độ rất nhanh... Chỉ đáng tiếc là vẫn chưa xử lý được vụ Unicode text. Hôm nay với cái /U của bạn thì.. ngon lành rồi
Cảm ơn nhiều nhé
Trước giờ tôi cũng thường dùng cách này để nghiên cứu lệnh DOS nhưng thật sự không để ý trong các lệnh DOS lại có lệnh cmd
Ẹc... Ẹc... mới thử xong ---> Cả 1 "rừng" luôn
-----------------
Người ta nói HỌC ĐI ĐỘI VỚI HÀNH... Vậy nên chỉ cần vài bài "hành" như ở đây đã bằng đọc mấy quyển sách rồi
Cảm ơn bạn!
Cũng cần nói rõ là nếu lệnh không "tuôn ra" text ở dạng unicode thì thông số /u cũng không làm gì được (nếu tôi không lầm). lệnh dir trả về text unicode nhưng có những lệnh không trả về unicode. Vd. lệnh xcopy sẽ copy các tập tin và hiển thị danh sách những tập tin đã được copy nhưng danh sách đó không phải unicode. find.exe tìm trong những tập tin cho trước những đoạn text cần tìm và nó trả về nội dung những dòng tìm thấy. Những đoạn cần tìm có thể là unicode nó cũng tìm ra nhưng khi trả về danh sách các dòng tìm thấy thì danh sách lại không là unicode.
--------------------
Một vài thông tin về cửa sổ dòng lệnh, tức "dư âm" của hệ điều hành DOS xa xưa.
1. Chuyển hướng In / Out
Dòng dữ liệu vào In và dòng dữ liệu ra Out. DOS cho phép "tuôn" dữ liệu vào và ra tới các thiết bị In / Out hoặc từ / tới tập tin. Trong DOS có nhiều loại thiết bị In / Out như NUL, CON, AUX, PRN, COMx (COM1, COM2, COM3, COM4), LPTx (LPT1, LPT2, ...). Tôi sẽ giới thiệu về NUL và CON.
CON là thiết bị In / Out mặc định. CON có nghĩa là console - màn hình và bàn phím. Mọi dữ liệu vào được mặc định đưa lên màn hình thông qua bàn phím. Mọi dữ liệu ra (các thông báo, yêu cầu, kết quả) được mặc định đưa ra màn hình. Tóm lại COM là thiết bị mặc định. Nhưng DOS cho phép chuyển hướng In / Out và đưa dữ liệu sang thiết bị khác (vd. máy in - LPT, chú ý là ta đang nói về hđh DOS. Trong cửa sổ dòng lệnh có thể khác) hoặc từ / tới tập tin. Cụ thể như thế nào?
a. Chuyển hướng OUT. Ta dùng "... > tập tin hoặc thiết bị đích"
Mã:
vd. dir c:\*.txt > d:\files.txt --> ENTER
Kết quả là dữ liệu ra, tức danh sách các tập tin TXT trên C, không được "tuôn" ra màn hình mà được chuyển hướng vào tập tin d:\files.txt do dir tạo ra.
b. Chuyển hướng OUT. Ta dùng "... >> tập tin hoặc thiết bị đích"
Chú ý là nếu ta dùng trong vd. a ở trên " ... > tập tin" thì kết quả được ghi ở đầu tập tin files.txt do dir tạo ra nếu files.txt chưa tồn tại. Còn nếu tập tin đã tồn tại thì nội dung của nó bị thay bởi kết quả. Vậy nếu ta muốn dùng dir 2 lần để "tuồn" 2 danh sách khác nhau vào cùng 1 tập tin thì làm thế nào? Thì dùng " ... >> ..." thôi. ">>" có nghĩa là dòng dữ liệu ra sẽ được ghi vào cuối tập tin.
Mã:
vd.
dir /b c:\*.txt >> d:\files.txt --> ENTER
dir /b c:\wincmd\*.txt >> d:\files.txt --> ENTER
Kết quả là trong d:\files.txt ta có danh sách các tập tin txt từ 2 thư mục khác nhau.
Thế nếu ta không muốn "tuôn" dòng dữ liệu vào màn hình cũng như vào tập tin thì làm thế nào?
vd. ta muốn copy các tập tin TXT từ c:\van_ban sang d:\luu_tru thì ta dùng
Mã:
copy c:\van_ban\*.txt d:\luu_tru --> ENTER
Nhưng nếu trong van_ban có 2000 tập tin TXT thì kết quả (tức thông báo của lệnh copy) "tuôn" ra màn hình sẽ là 2000 dòng tên các tập tin và dòng cuối là: Tổng số các tập tin được sao: 2000
Nếu ta thao tác lâu ở dòng lệnh thì 2001 dòng kia đúng là rác, làm phiền ta. Ta có thể chuyển hướng
để ghi 2001 dòng thông báo đó vào tập tin cho khuất mắt nhưng ta cũng có thể dùng NUL - tức chuyển hướng tới "chả là gì cả", tức chuyển vào "hư vô"
Mã:
copy c:\van_ban\*.txt d:\luu_tru > NUL
2. Chuyển hướng In "... < ..."
Bình thường thì dữ liệu vào được lấy thông qua bàn phím và hiển thị trên màn hình - thiết bị IN / Out mặc định CON.
Mã:
copy c:\*.txt d:\
vd. trên copy tất cả các tập tin TXT trong C:\ sang D:\. Thế nếu trên D:\ đã có 1 số tập tin TXT có tên như tập tin đang phải copy thì sao? Thì lúc đó copy sẽ hiển thị thông báo kiểu (ngôn ngữ tùy phiên bản Windows):
PHP:
c:\xyz.txt
Rewrite d:\xyz.txt? <Yes/No/All>
Lúc đó người dùng phải nhấn: y + ENTER (yes), n + ENTER (No), a + ENTER (all)
Thế nếu người dùng lười hoặc nếu là code viết trong VBA để chạy tự động thì sao? DOS cho phép lấy dữ liệu vào (ở đây là câu trả lời của người dùng) từ nguồn khác với nguồn bàn phím. Tức ta có thể soạn tập tin chứa câu trả lời của ta và cung cấp nó như là nguồn vào. Ví dụ ta muốn khi có những tập tin trùng thì ghi đè TẤT CẢ. Vậy ta phải cung cấp a và ENTER. Ta mở notepad và nhấn phím a, tiếp đó nhấn ENTER, sau đó ghi lại vd. trên C:\ với tên cau_tra_loi.txt. Trong cửa sổ dòng lệnh ta gõ
Mã:
copy c:\*.txt d:\ < c:\tra_loi.txt
Lúc này thì nếu có các tập tin trùng thì chúng sẽ bị ghi đè mà người dùng không phải nhấn phím a + ENTER nữa vì câu trả lời đã có trong tập tin c:\tra_loi.txt và " < c:\tra_loi.txt" thông báo là nguồn dữ liệu vào (ở đây là câu trả lời) là tập tin c:\tra_loi.txt
Ở trên là 1 câu trả lời. Có nhiều khi ta phải trả lời vài lần. Ví dụ trong DOS nếu ta format vd. đĩa mềm thì đầu tiên format thông báo là hãy chắc chắn là đã đút đĩa mềm vào ổ rồi nhấn ENTER để bắt đầu. Khi format xong thì format hỏi có đặt Label không, nếu ta đặt thì gõ tên rồi ENTER, nếu không thì chỉ ENTER. Khi đã xong xuôi rồi thì format còn nhì nhằng: có format tiếp các đĩa khác không. Nếu ta không format tiếp thì nhấn N. Như vậy phiền quá. Có 3 chỗ phải trả lời. Vậy ta mở notepad rồi nhấn liên tiếp: ENTER --> ENTER --> n (--> chỉ để minh họa, không gõ)
Sau đó ta ghi trên C:\ với tên tra_loi.txt. Trong dòng lệnh ta viết:
Mã:
format A: < c:\tra_loi.txt
Lúc này ta không phải nhấn phím 3 lần nữa.
------------
Cuối cùng ta bàn chút về việc copy nhưng giữ nguyên cấu trúc của thư mục nguồn. Có ai đó đã bỏ công ra sắp xếp các tập tin của mình vào từng thư mục con theo chủ đề. Bây giờ anh ta muốn copy một số tập tin nhưng vẫn giữ cấu trúc như cũ.
xcopy sẽ làm được việc đó. Nó có thể copy và giữ nguyên cấu trúc nguồn. Code như sau:
Mã:
Sub Xcopy(ByVal srcDir As String, ByVal destDir As String, ByVal Pattern As String, _
Optional ByVal InSub As Boolean = True)
' neu InSub TRUE thi tim ca trong cac thu muc con.
' cac tap tin tim duoc se duoc copy sang thu muc destDir va dam bao giu nguyen cau
' truc nhu o thu muc goc srcDir. vd. thu muc goc la ...\bla co 2 thu muc con la bla\he1 va bla\he2. Trong \bla co tap tin
' bla.txt, trong bla\he1 co he1.txt, trong bla\he2 co he2.txt thi khi tim va copy tat ca cac tap tin TXT thi tai thu muc
' destDir se duoc tao 2 thu muc con la he1 va he2, va trong thu muc destDir se xuat hien tap tin bla.txt, trong
' destDir\he1 - he1.txt, trong destDir\he2 - he2.txt
Dim sCmd As String, tmpFile As String, text As String, k As Long, count As Long, argArr, tmpArr, Arr, sh As Object
On Error GoTo ExitSub
If Right(srcDir, 1) <> "\" Then srcDir = srcDir & "\"
srcDir = """" & srcDir & """"
If Right(destDir, 1) <> "\" Then destDir = destDir & "\"
destDir = """" & destDir & """"
argArr = Split(Pattern, ";")
Set sh = CreateObject("Wscript.Shell")
' copy lan luot cac tap tin khop voi pattern hien hanh
For k = LBound(argArr) To UBound(argArr)
' dong lenh
sCmd = "xcopy " & srcDir & argArr(k) & " " & destDir & " /h /k /r /y " & IIf(InSub, "/s", vbNullString)
' copy cac tap tin va ghi danh sach ra tmpFile
sh.Run "cmd /c " & sCmd, 0, True
Next k
ExitSub:
Set sh = Nothing
End Sub
Có file đính kèm. Vd. sẽ copy tất cả các tập tin có dạng *.xls và *.xlxs có trong thư mục có xcopy.xls (tập tin ví dụ). Vậy để test thì phải tải xcopy.xls về thư mục có những tập tin như đã chỉ ở trên.
code đã được thử trên XP + Excel2007 và Win7 + Excel 2007
Nói ngoài lề chút: Có vẻ như bạn siwtom đã.. lớn tuổi?
Vì tôi để ý thấy các bạn trẻ bây giờ ít ai còn biết đến DOS Command, mà bạn thì lại rất siêu phần này
Tôi đoán đúng chứ?
---------------------------
Hy vọng khi nào rảnh rỗi, bạn mở hẳn 1 topic chuyên về DOS, nhất là những câu lệnh có thể "nhúng" vào VB, VBA (tôi cũng dùng DOS khá nhiều nhưng "biết" lại chẳng được bao nhiêu)
Cảm ơn trước nha!
