hakhuongdhkt
Gnouhk
- Tham gia
- 26/8/14
- Bài viết
- 42
- Được thích
- 2
- Giới tính
- Nam
Em có 2 đoạn code dùng để lấy tất cả tên các file trong một folder.
Đối với những folder nhỏ, tốc độ 2 code đều như nhau. Nhưng với folder lớn, nhiều thư mục con thì mã 2 chạy lâu hơn rất nhiều ( code 1 chỉ mất vài giây).
Nhưng, vấn đề là code 1 không hiển thị được tên file có dấu tiếng việt; cách 2 lại hiển thị được.
Vậy mong các bác hướng dẫn cách nào để code 2 chạy nhanh hơn được không ạ?
Code 1: Dùng CMD & Dir
Code 2: Dùng Window API & Đệ quy
Đối với những folder nhỏ, tốc độ 2 code đều như nhau. Nhưng với folder lớn, nhiều thư mục con thì mã 2 chạy lâu hơn rất nhiều ( code 1 chỉ mất vài giây).
Nhưng, vấn đề là code 1 không hiển thị được tên file có dấu tiếng việt; cách 2 lại hiển thị được.
Vậy mong các bác hướng dẫn cách nào để code 2 chạy nhanh hơn được không ạ?
Code 1: Dùng CMD & Dir
Mã:
Sub GetFilename()
Dim fldpath
Application.ScreenUpdating = False
Sheets(1).Range("A6:C" & Rows.Count).Clear
fldpath = "C:\Temp"
If fldpath = False Then
'MsgBox "Folder Not Selected"
Exit Sub
End If
sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & fldpath & """ /s /b /a:-d").StdOut.ReadAll, vbCrLf)
Sheets(1).Cells(6, 3).Resize(UBound(sn) + 1) = Application.Transpose(sn)
Call splitfilename
Application.ScreenUpdating = True
End SubCode 2: Dùng Window API & Đệ quy
Mã:
Option Explicit
Private Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As LongPtr) As Long
Private Declare PtrSafe Function FindFirstFileW Lib "kernel32" (ByVal lpFileName As LongPtr, ByVal lpFindFileData As LongPtr) As LongPtr
Private Declare PtrSafe Function FindNextFileW Lib "kernel32" (ByVal hFindFile As LongPtr, ByVal lpFindFileData As LongPtr) As LongPtr
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Const MAX_PATH As Long = 260
Const ALTERNATE As Long = 14
' Can be used with either W or A functions
' Pass VarPtr(wfd) to W or simply wfd to A
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * ALTERNATE
End Type
Public arr As Variant
Public n As Long
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = 16 '0x10
Private Const INVALID_HANDLE_VALUE As LongPtr = -1
Public Function searchfile(sfolder As String) As Variant
Dim hFile As LongPtr
Dim foundItem As String
Dim folderPath As String
Dim wfd As WIN32_FIND_DATA
folderPath = sfolder & "\"
hFile = FindFirstFileW(StrPtr(folderPath & "*"), VarPtr(wfd))
If hFile <> INVALID_HANDLE_VALUE Then
Do While FindNextFileW(hFile, VarPtr(wfd))
foundItem = Left$(wfd.cFileName, InStr(wfd.cFileName, vbNullChar) - 1)
If foundItem = "." Or foundItem = ".." Then
'Found Directory
ElseIf wfd.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
searchfile (folderPath & foundItem)
ElseIf InStr(1, foundItem, vbTextCompare) > 0 Then 'for performance
'Debug.Print Left$(wfd.cFileName, InStr(wfd.cFileName, vbNullChar) - 1)
If IsArray(arr) Then
ReDim Preserve arr(1 To 3, 1 To n)
Else
ReDim arr(1 To 3, 1 To n)
End If
arr(1, n) = wfd.cFileName
arr(2, n) = folderPath 'Left(folderPath, Len(folderPath) - 1)
arr(3, n) = folderPath & wfd.cFileName
n = n + 1
End If
Loop
FindClose hFile
End If
searchfile = arr
End Function
Sub getfilename()
Application.ScreenUpdating = False
Dim fpath As String
Dim resultarr As Variant
n = 1
fpath = "C:\Temp"
resultarr = searchfile(fpath)
Sheet1.Range("A2:C" & UBound(resultarr, 2) + 1).Value = Application.Transpose(resultarr)
Application.ScreenUpdating = True
End Sub
Lần chỉnh sửa cuối:
