Trong ổ đĩa D: Tôi có một thư mục VBA_GPE. Thư mục này được đặt trong một thư mục nào đó (không xác định được tên, cấp thư mục) và trong nó có các thư mục con và file.
Trong ổ đĩa D: Tôi có một thư mục VBA_GPE. Thư mục này được đặt trong một thư mục nào đó (không xác định được tên, cấp thư mục) và trong nó có các thư mục con và file.
Ý của tôi là thế này
Nếu biết trước đường dẫn của thư mục VBA_GPE là "D:\CHINH 2011\VBA_GPE" thì tôi dùng Code sau:
Mã:
Sub Open_Foldres()
On Error Resume Next
With CreateObject("Shell.Application")
.Open "D:\CHINH 2011\VBA_GPE"
End With
End Sub
Nhưng do không biết thư mục VBA_GPE nằm ở thư mục nào nên phải tìm đường dẫn của nó. Mày mò từ sáng đến giờ nhưng không được. Rất mong được sự hỗ trợ của các Bạn. Thanks !
Ý của tôi là thế này
Nếu biết trước đường dẫn của thư mục VBA_GPE là "D:\CHINH 2011\VBA_GPE" thì tôi dùng Code sau:
Mã:
Sub Open_Foldres()
On Error Resume Next
With CreateObject("Shell.Application")
.Open "D:\CHINH 2011\VBA_GPE"
End With
End Sub
Nhưng do không biết thư mục VBA_GPE nằm ở thư mục nào nên phải tìm đường dẫn của nó. Mày mò từ sáng đến giờ nhưng không được. Rất mong được sự hỗ trợ của các Bạn. Thanks !
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 Sub
PHP:
Private 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 Sub
Ý của tôi là thế này
Nếu biết trước đường dẫn của thư mục VBA_GPE là "D:\CHINH 2011\VBA_GPE" thì tôi dùng Code sau:
Mã:
Sub Open_Foldres()
On Error Resume Next
With CreateObject("Shell.Application")
.Open "D:\CHINH 2011\VBA_GPE"
End With
End Sub
Nhưng do không biết thư mục VBA_GPE nằm ở thư mục nào nên phải tìm đường dẫn của nó. Mày mò từ sáng đến giờ nhưng không được. Rất mong được sự hỗ trợ của các Bạn. Thanks !
Tôi thì luôn nghĩ rằng nếu dùng Windows API thì vẫn nhanh hơn. Nếu "cái gì đó" cuối cùng cũng gọi hàm API thì viết thẳng bằng API tốc độ vẫn nhanh hơn. Với giả thiết là cả 2 code bằng API và bằng Scripting đều tối ưu.
Tôi thử viết bằng API, viết "từ trong đầu ra" nên phải kiểm nghiệm. Cũng không có bẫy lỗi gì cả.
Nếu bạn quan tâm thì bạn thử test tốc độ xem. Đặt thư mục thật sâu vào: trên D có nhiều tập tin, thư mục --> chọn thư mục có nhiều tập tin và thư mục --> trong nó chọn thư mục ... --> trong thư mục thứ n tạo thư mục "VBA_GPE" rồi test
-----------
Public Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Public Const MAX_PATH As Long = 260
Public Const INVALID_HANDLE_VALUE As Long = &HFFFFFFFF '((Handle) - 1)
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 * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function GetTickCount Lib "kernel32" () As Long
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 Long
HTML:
Private 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 Function
Sub Button1_Click()
Dim s As String, t As Double
t = GetTickCount
s = FindOneDirectory("D:\", "VBA_GPE")
Debug.Print (GetTickCount - t) / 1000
MsgBox s
End Sub
Ý của tôi là thế này
Nếu biết trước đường dẫn của thư mục VBA_GPE là "D:\CHINH 2011\VBA_GPE" thì tôi dùng Code sau:
Mã:
Sub Open_Foldres()
On Error Resume Next
With CreateObject("Shell.Application")
.Open "D:\CHINH 2011\VBA_GPE"
End With
End Sub
Nhưng do không biết thư mục VBA_GPE nằm ở thư mục nào nên phải tìm đường dẫn của nó. Mày mò từ sáng đến giờ nhưng không được. Rất mong được sự hỗ trợ của các Bạn. Thanks !
Tôi làm thêm hàm tìm cac tập tin va thu muc.
Nếu bạn có thời gian thì kiểm tra hộ code
Mã:
Private 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 Sub
Lỗi là vì anh không copy hết code
Đầy đủ phải vầy:
PHP:
Public 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 Long
PHP:
Private 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 Function
PHP:
Sub Button1_Click()
Dim s As String
s = FindOneDirectory("D:\", "LearnVBA")
MsgBox s
End Sub