Đánh giá chủ đề:
  • 4 Votes - 2.5 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Làm việc với folders
#1
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

Chữ ký của haquocquan Guest, you are welcome!
ღღღღღTài sản của haquocquan (View All Items) ღღღღღ
Reply
Những người đã cảm ơn Noname
#2
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

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

Nguồn: KHPT.net
Chữ ký của haquocquan Guest, you are welcome!
ღღღღღTài sản của haquocquan (View All Items) ღღღღღ
Reply
Những người đã cảm ơn Noname , Cafe Via He
#3
Cám ơn bạn, bạn có thể làm dùm mình cái file mdb ví dụ được không ?
Chữ ký của DoquangLam Hãy chia sẻ kinh nghiệm cùng mình trên ThuThuatAccess nhé! Chúc vui vẻ rose
Reply
Những người đã cảm ơn
#4
(17-11-10, 10:32 PM)DoquangLam Đã viết: Cám ơn bạn, bạn có thể làm dùm mình cái file mdb ví dụ được không ?

DEMO: list file
Copy vào một thư mục nào đó chạy thử form1


File đính kèm
.zip   db1.zip (Kích cỡ: 113.93 KB / Tải về: 108)
Chữ ký của haquocquan Guest, you are welcome!
ღღღღღTài sản của haquocquan (View All Items) ღღღღღ
Reply
Những người đã cảm ơn Noname , maidinhdan
#5
Không tải về được, mong bạn Noname can thiệp dùm nhé
Chữ ký của DoquangLam Hãy chia sẻ kinh nghiệm cùng mình trên ThuThuatAccess nhé! Chúc vui vẻ rose
Reply
Những người đã cảm ơn
#6
Bạn thử lại với link này xem:
http://dl.dropbox.com/u/14777478/sharedi...forder.zip
Chữ ký của Noname 020
ღღღღღTài sản của Noname (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#7
Cám ơn rất nhiều nhiều
Chữ ký của DoquangLam Hãy chia sẻ kinh nghiệm cùng mình trên ThuThuatAccess nhé! Chúc vui vẻ rose
Reply
Những người đã cảm ơn
#8
Bây giờ mình muốn như vầy nhé : Các bạn có thể thêm code vào đâu đó để khi mình mở Form1 lên thì nó xoá hết dữ liệu trong tblFileDataList đi rồi mới thực hiện lệnh Call ListFiles(Application.CurrentProject.Path, "*.*", True)

Như vậy có được không ? Mong các bạn hướng dẫn. Cám ơn
Chữ ký của DoquangLam Hãy chia sẻ kinh nghiệm cùng mình trên ThuThuatAccess nhé! Chúc vui vẻ rose
Reply
Những người đã cảm ơn
#9
Bạn đặt code trong sự kiện On Open của form:

Mã:
Private Sub Form_Open(Cancel As Integer)
On error resume next
CurrentDb.Execute "delete * from tblFileDataList"

Call ListFiles(Application.CurrentProject.Path, "*.*", True)

End Sub
Chữ ký của haquocquan Guest, you are welcome!
ღღღღღTài sản của haquocquan (View All Items) ღღღღღ
Reply
Những người đã cảm ơn Noname
#10
Tiếp: Liệt kê các subfolders trong một folder:
Đoạn code dưới đây sẽ liệt kế các subfolders trong folder E:\XUAT\ vào table LuuSub

Mã:
Sub ListFolder()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim FSOfolder As Object
Dim subfolder As Object

Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("LuuSub", dbOpenDynaset)
Set FSOfolder = FSO.GetFolder("E:\XUAT\")
    
    For Each subfolder In FSOfolder.SubFolders
        rs.AddNew
        rs!abc = subfolder.Name
        rs.Update
        
    Next subfolder
    
    Set FSOfolder = Nothing

End Sub
Chữ ký của haquocquan Guest, you are welcome!
ღღღღღTài sản của haquocquan (View All Items) ღღღღღ
Reply
Những người đã cảm ơn Noname


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  Hướng dẫn cơ bản về việc lập báo cáo tồn kho và in thẻ kho bằng query Xuân Thanh 30 14,948 13-02-15, 10:47 PM
Bài mới nhất: thucgia

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ