Windows folder as a record source for a subform

[Thomasso]

Hi,

I want to work with Windows Files in MS Access. For example I have a Purchase Order that has associated attachments with it. Those are stored on my company server. I want to display and be able to open/add/remove attachments directly in MS Access.

I'm able to do this using list boxes like so:

Private Sub RefreshListBox()

    Dim FileName As String
    Dim Path As String
    
    Me.lboAttachments.RowSource = ""
    
    Path = "\attachments\purchase_orders\" & Me.PurchaseOrderID & "\"
    
    FileName = Dir(AppSharedFolder & Path & "*", vbNormal)
    
    Do While Len(FileName) > 0
        Me.lboAttachments.AddItem FileName
        FileName = Dir()
    Loop

End Sub

Private Sub Form_Current()

    RefreshListBox

End Sub

(Note: AppSharedFolder is a constant with a folder where all files for the application are stored)

I also have lots of other code for uploading, opening and deleting attachments.



I am wondering, however, if this can be accomplished using a subform instead of a list box, purely for esthetical purposes.

Thanks in advance.
Tomas

[Welshgasman]

Yes, but you would need to put the filenames into a table?

I seem to recall @Davegri? uploaded a DB to do just that.?

Have a search here.

[Minty]

You could simply add the the filenames to a temporary table, from the Dir() function, and display that in your form.

[Thomasso]

Yep, that did the trick, thanks!

[moke123]

Personally I prefer FSO when working with windows folders and files.

To list files to a listbox I use:

Public Sub ListFilesListBox(SourceF As String, Lbx As ListBox, Optional IncSubFolders As Boolean = True)

    'Dim fso As New FileSystemObject                            'early binding
    'Dim fol As Folder, sfol As Folder, fil As File    

    Dim fso As Object                                          'late binding
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim fol As Object, sfol As Object, fil As Object 

    Set fol = fso.GetFolder(SourceF)

    For Each fil In fol.Files
        Lbx.AddItem fil.Name & ";" & fil.Path & ";" & fil.DateLastModified & ";" & fil.Type
    Next

    If IncSubFolders Then
        For Each sfol In fol.SubFolders
            ListFilesListBox sfol.Path, Lbx, IncSubFolders
        Next
    End If

End Sub

When writing files to a table I use the below code. I use a dictionary to insure that no duplicate entries are added to the table.

'Dim dict As Scripting.Dictionary   'early binding
Dim dict As Object                  'Late binding


Sub ListMyFilesToTable(SourceF As String, Optional IncSubFolders As Boolean = True)


PopulateDictionary


sListFilesTableNoDups SourceF, IncSubFolders


End Sub


Sub PopulateDictionary()


     'Set dict = New Scripting.Dictionary                 'early binding
     Set dict = CreateObject("Scripting.Dictionary")      'Late binding


    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strSql As String
    Dim strOut As String
    
    strSql = "Select * from tblFiles"


    Set db = CurrentDb()
    Set rs = db.OpenRecordset(strSql)


    If rs.BOF And rs.EOF Then
        GoTo MyExit
    End If
    
    Do Until rs.EOF
    
    dict.Add CStr(rs!fpath), CStr(rs!fpath)
    
    rs.MoveNext
    Loop


   
MyExit:
    rs.Close
    Set rs = Nothing
    Set db = Nothing


End Sub


Sub sListFilesTableNoDups(SourceF As String, Optional IncSubFolders As Boolean = True)


    Dim strSql As String
    Dim db As DAO.Database
    Set db = CurrentDb
   
    'Dim fso As New FileSystemObject                            'early binding
    'Dim fol As Folder, sfol As Folder, fil As File
    
        Dim fso As Object                                          'late binding
        Set fso = CreateObject("Scripting.FileSystemObject")
        Dim fol As Object, sfol As Object, fil As Object
    
    Set fol = fso.GetFolder(SourceF)


    For Each fil In fol.Files
        If Not dict.Exists(fil.Path) Then
            strSql = "Insert into tblFiles(FName,FPath,dteCreated,dteModified) Values(""" & fil.Name & """,""" & fil.Path & """,#" & fil.DateCreated & "#,#" & fil.DateLastModified & "#)"
            db.Execute strSql, dbFailOnError
        End If
    Next


    If IncSubFolders Then
        For Each sfol In fol.SubFolders
            sListFilesTableNoDups sfol.Path, IncSubFolders
        Next
    End If


    Set db = Nothing


End Sub