Sub Open_Foldres()
On Error Resume Next
With CreateObject("Shell.Application")
.Open "D:\CHINH 2011\VBA_GPE"
End With
End Sub
Thì anh cứ dò tìm thôi! Code liệt kê thư mục có đầy trên GPE rồi mà anh
Public tmp As String
Sub Test()
Dim SearchFolder As String, SearchIn As String
tmp = ""
SearchFolder = "VBA_GPE"
SearchIn = "D:\"
FindFolder SearchFolder, SearchIn, True
If tmp <> "" Then MsgBox tmp
End SubPrivate Sub FindFolder(SearchFolder As String, SearchIn As String, InSub As Boolean)
Dim SubFld As Object
On Error Resume Next
With CreateObject("Scripting.FileSystemObject")
With .GetFolder(SearchIn)
If UCase(SearchFolder) = UCase(.Name) Then
tmp = .Path
Exit Sub
End If
If InSub Then
For Each SubFld In .SubFolders
FindFolder SearchFolder, SubFld.Path, True
Next SubFld
End If
End With
End With
End SubPrivate Function FindOneDirectory(ByVal DirStart As String, ByVal Filename As String) As String
Dim FindData As WIN32_FIND_DATA, FindData1 As WIN32_FIND_DATA
Dim FindHandle As Long, res As Boolean
Dim pos As Long, dir As String
If Right(DirStart, 1) <> "\" Then DirStart = DirStart & "\"
FindHandle = FindFirstFile(DirStart & Filename, FindData)
If (FindHandle <> INVALID_HANDLE_VALUE) And _
((FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) Then
FindOneDirectory = DirStart & FindData.cFileName
Else
FindHandle = FindFirstFile(DirStart & "*", FindData1)
res = FindHandle <> INVALID_HANDLE_VALUE
Do While (FindOneDirectory = "") And res
If (Left(FindData1.cFileName, 1) <> ".") And _
((FindData1.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) Then
pos = InStr(1, FindData1.cFileName, Chr(0))
dir = Left(FindData1.cFileName, pos - 1)
FindOneDirectory = FindOneDirectory(DirStart & dir, Filename)
End If
res = FindNextFile(FindHandle, FindData1) <> 0
Loop
End If
If FindHandle <> INVALID_HANDLE_VALUE Then FindClose (FindHandle)
End FunctionPrivate Sub DoSomething(ByVal path As String)
' lam gi do voi ket qua tim duoc, vd. mo tap tin va doc du lieu
End Sub
Public Function FindMatchedFiles(ByVal DirStart As String, ByVal Filename As String, _
ByVal SubDir As Boolean, ByVal AllowedDirectory As Boolean)
' neu AllowedDirectory = FALSE thi chi tim cac tap tin co ten khop voi Filename
' neu AllowedDirectory = TRUE thi tim ca cac thu muc co ten khop voi Filename
' Neu SubDir = FALSE thi chi tim o thu muc khoi dau, neu = TRUE thi tim o tat ca cac
' thu muc con, chau, chat, chit ...
Dim FindData As WIN32_FIND_DATA
Dim FindHandle As Long
Dim validDir As Boolean
Dim fName As String, pos As Long
If Right(DirStart, 1) <> "\" Then DirStart = DirStart & "\"
FindHandle = FindFirstFile(DirStart & Filename, FindData)
If FindHandle <> INVALID_HANDLE_VALUE Then
Do
If ((FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = 0) Or AllowedDirectory Then
pos = InStr(1, FindData.cFileName, Chr(0))
fName = Left(FindData.cFileName, pos - 1)
Call DoSomething(DirStart & fName)
End If
Loop Until FindNextFile(FindHandle, FindData) = 0
End If
If FindHandle <> INVALID_HANDLE_VALUE Then FindClose (FindHandle)
If Not SubDir Then Exit Function
FindHandle = FindFirstFile(DirStart & "*", FindData)
If FindHandle <> INVALID_HANDLE_VALUE Then
Do
pos = InStr(1, FindData.cFileName, Chr(0))
fName = Left(FindData.cFileName, pos - 1)
validDir = ((FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
(Left(fName, 1) <> ".") And (UCase(fName) <> "RECYCLE") And (UCase(fName) <> "RECYCLER")
If validDir Then
FindMatchedFiles = FindMatchedFiles(DirStart & fName, Filename, _
SubDir, AllowedDirectory)
End If
Loop Until FindNextFile(FindHandle, FindData) = 0
Debug.Print GetLastError
End If
If FindHandle <> INVALID_HANDLE_VALUE Then FindClose (FindHandle)
End Function
Sub Button2_Click()
s = ""
FindMatchedFiles "D:\", "bla", True, True
MsgBox s
End SubPublic Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Public Const INVALID_HANDLE_VALUE As Long = &HFFFFFFFF
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public 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 * 260
cAlternate As String * 14
End Type
Public Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As LongPrivate Function FindOneDirectory(ByVal DirStart As String, ByVal Filename As String) As String
Dim FindData As WIN32_FIND_DATA, FindData1 As WIN32_FIND_DATA
Dim FindHandle As Long, res As Boolean
Dim pos As Long, dir As String
If Right(DirStart, 1) <> "\" Then DirStart = DirStart & "\"
FindHandle = FindFirstFile(DirStart & Filename, FindData)
If (FindHandle <> INVALID_HANDLE_VALUE) And ((FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) Then
FindOneDirectory = DirStart & FindData.cFileName
Else
FindHandle = FindFirstFile(DirStart & "*", FindData1)
res = FindHandle <> INVALID_HANDLE_VALUE
Do While (FindOneDirectory = "") And res
If (Left(FindData1.cFileName, 1) <> ".") And ((FindData1.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) Then
pos = InStr(1, FindData1.cFileName, Chr(0))
dir = Left(FindData1.cFileName, pos - 1)
FindOneDirectory = FindOneDirectory(DirStart & dir, Filename)
End If
res = FindNextFile(FindHandle, FindData1) <> 0
Loop
End If
If FindHandle <> INVALID_HANDLE_VALUE Then FindClose (FindHandle)
End FunctionSub Button1_Click()
Dim s As String
s = FindOneDirectory("D:\", "LearnVBA")
MsgBox s
End Sub
