• Trang chủ click to expand contents 

  • Làm việc với folders

  • Làm việc với folders

    haquocquan > 13-11-10, 12:18 AM

    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

  • RE: Làm việc với folders

    haquocquan > 17-11-10, 12:34 AM

    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

  • RE: Làm việc với folders

    DoquangLam > 17-11-10, 10:32 PM

    Cám ơn bạn, bạn có thể làm dùm mình cái file mdb ví dụ được không ?

  • RE: Làm việc với folders

    haquocquan > 17-11-10, 11:00 PM

    (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

  • RE: Làm việc với folders

    DoquangLam > 17-11-10, 11:32 PM

    Không tải về được, mong bạn Noname can thiệp dùm nhé

  • RE: Làm việc với folders

    Noname > 17-11-10, 11:41 PM

    Bạn thử lại với link này xem:
    http://dl.dropbox.com/u/14777478/sharedi...forder.zip

  • RE: Làm việc với folders

    DoquangLam > 17-11-10, 11:55 PM

    Cám ơn rất nhiều nhiều

  • RE: Làm việc với folders

    DoquangLam > 18-11-10, 05:25 PM

    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

  • RE: Làm việc với folders

    haquocquan > 18-11-10, 05:41 PM

    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

  • RE: Làm việc với folders

    haquocquan > 17-02-11, 12:14 AM

    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