Làm Việc với Folder

Tác giả: Haquocquan

Site: http://thuthuataccess.com

Vui lòng giữ nguyên tên tác giả và site khi bạn sử dụng hoặc dùng lại thủ thuật này

-------------------------------------------
1. Kiểm tra xem folder có tồn tại hay không.

Mã:

Function FolderCheck(sPath As String) As Boolean
If Right(sPath, 1) = "\" Then
sPath = Left(sPath, Len(sPath) - 1)
End If
Dim filesys
Set filesys = CreateObject("Scripting.FileSystemObject")
FolderCheck = filesys.FolderExists(sPath)
End Function

2. Tạo folder mới:

Mã:

MkDir sPath

3. Xóa folder:

Mã:

RmDir sPath

4/ Liệt kê tất cả các file trong một folder đưa vào table:

Mã:

Sub ListFiles(strPath As String, Optional strFileSpec As String, Optional bIncludeSubfolders As Boolean)
On Error GoTo Err_Handler
Dim colDirList As New Collection
Dim varItem As Variant

Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)

Dim rsfile As Recordset
Set rsfile = CurrentDb.OpenRecordset("tblList", dbOpenDynaset)

For Each varItem In colDirList
rsfile.AddNew
rsfile!filename = varItem
rsfile.Update
'lst.AddItem varItem
Next
'End If

Exit_Handler:
Exit Sub

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Sub

Mã:

Sub FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, bIncludeSubfolders As Boolean)
'Build up a list of files, and then add add to this list, any additional folders
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

'Add the files to the folder.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
colDirList.Add strFolder & strTemp
strTemp = Dir
Loop

If bIncludeSubfolders Then
'Build collection of additional subfolders.
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
Next vFolderName
End If
End Sub

Mã:

Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function

---

5/Xóa tất cả các file và subfolders trong một folder

Mã:

Sub XoaTatCa()
Dim FSO As Object
Dim MyPath As String
Set FSO = CreateObject("scripting.filesystemobject")

MyPath = spath '<< thay doi duong dan nhe

If Right(MyPath, 1) = "\" Then
MyPath = Left(MyPath, Len(MyPath) - 1)
End If

If FSO.FolderExists(MyPath) = False Then
MsgBox MyPath & " khong ton tai"
Exit Sub
End If

On Error Resume Next
FSO.deletefile MyPath & "\*.*", True
FSO.deletefolder MyPath & "\*.*", True
MsgBox "Da xoa xong !"
On Error GoTo 0

End Sub

Thảo luận thêm tại đây: http://thuthuataccess.com/forum/Thread-lam-viec-voi-folders
Demo: Layfiletrongforder.zip