List files (1 Viewer)

freeon

Registered User.
Local time
Today, 14:48
Joined
Oct 29, 2018
Messages
17
I'm using below code found on another site to list all files in a specific folder and all of it's sub folder. When I run the code I get a message saying files were added, however the table remains blank. As soon as I hit F5 the table loads as it should. What can I add to the code so the table is update when the code runs. Also this code currently displays the file path in one of the fields that has data type set as Hyperlink. However clicking on it does nothing and going to edit hyperlink the address is blank. Additionally I would like for the display text to be the file name instead of the file path.

Code:
Option Compare Database
Option Explicit

'list files to tables
'http://allenbrowne.com/ser-59alt.html

Dim gCount As Long ' added by Crystal

Sub runListFiles()
    'Usage example.
    Dim strPath As String _
    , strFileSpec As String _
    , booIncludeSubfolders As Boolean
    
    strPath = "\\BSMSBS2011\RedirectedFolders\leonb\My Documents\Personal\PC2"
    strFileSpec = "*.*"
    booIncludeSubfolders = True
    
    ListFilesToTable strPath, strFileSpec, booIncludeSubfolders
End Sub

'crystal modified parameter specification for strFileSpec by adding default value
Public Function ListFilesToTable(strPath As String _
    , Optional strFileSpec As String = "*.*" _
    , Optional bIncludeSubfolders As Boolean _
    )
On Error GoTo Err_Handler
    'Purpose:   List the files in the path.
    'Arguments: strPath = the path to search.
    '           strFileSpec = "*.*" unless you specify differently.
    '           bIncludeSubfolders: If True, returns results from subdirectories of strPath as well.
    'Method:    FilDir() adds items to a collection, calling itself recursively for subfolders.
    
    Dim colDirList As New Collection
    Dim varitem As Variant
    Dim rst As DAO.Recordset
    
   Dim mStartTime As Date _
      , mSeconds As Long _
      , mMin As Long _
      , mMsg As String
      
   mStartTime = Now()
   '--------
    
    Call FillDirToTable(colDirList, strPath, strFileSpec, bIncludeSubfolders)
      
   mSeconds = DateDiff("s", mStartTime, Now())
   
   mMin = mSeconds \ 60
   If mMin > 0 Then
      mMsg = mMin & " min "
      mSeconds = mSeconds - (mMin * 60)
   Else
      mMsg = ""
   End If
   
   mMsg = mMsg & mSeconds & " seconds"
   
   MsgBox "Done adding " & Format(gCount, "#,##0") & " files from " & strPath _
      & IIf(Len(Trim(strFileSpec)) > 0, " for file specification --> " & strFileSpec, "") _
      & vbCrLf & vbCrLf & mMsg, , "Done"
  
Exit_Handler:
   SysCmd acSysCmdClearStatus
   '--------
    
    Exit Function

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, , "ERROR"
    
    'remove next line after debugged -- added by Crystal
    Stop: Resume 'added by Crystal
    
    Resume Exit_Handler
End Function

Private Function FillDirToTable(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
    On Error GoTo Err_Handler
    
    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant
    Dim strSQL As String

    'Add the files to the folder.
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
         gCount = gCount + 1
         SysCmd acSysCmdSetStatus, gCount
         strSQL = "INSERT INTO Files " _
          & " (FName, FPath) " _
          & " SELECT """ & strTemp & """" _
          & ", """ & strFolder & """;"
         CurrentDb.Execute strSQL
        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 FillDirToTable(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
        Next vFolderName
    End If

Exit_Handler:
    
    Exit Function

Err_Handler:
    strSQL = "INSERT INTO Files " _
    & " (FName, FPath) " _
    & " SELECT ""  ~~~ ERROR ~~~""" _
    & ", """ & strFolder & """;"
    CurrentDb.Execute strSQL
    
    Resume Exit_Handler
End Function

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
 
Hi. I would suggest leaving the list files code alone and simply create an UPDATE query to change the hyperlink field in the table after you finished listing all the files. Your process could go something like this:

1. Select the table and close it
2. Run the list files code
3. Run the update query
4. Open the table
 
I'm using below code found on another site to list all files in a specific folder and all of it's sub folder. When I run the code I get a message saying files were added, however the table remains blank. As soon as I hit F5 the table loads as it should. What can I add to the code so the table is update when the code runs. Also this code currently displays the file path in one of the fields that has data type set as Hyperlink. However clicking on it does nothing and going to edit hyperlink the address is blank. Additionally I would like for the display text to be the file name instead of the file path.

I've used that code by Allen Browne for years. It works perfectly.

If you have a table open it won't update until you refresh it
If you are running this on a form with the table shown as a subform, add the line Me.Requery after the code

The code populates a table with 4 fields: FileID, FName, FPath & DateCreated
In the original code, FName & FPath fields are both text.
Use the Hyperlink datatype is always problematic and best avoided as to work properly it needs 2 components: URL & display name.
You will see this if you add a link to one of your posts.
The code doesn't have both parts so the link will do nothing

You can make your form display just the file name by showing the FName field
 
OK so now I have it setup to run the code then open the form when the database opens. It works, however every-time it opens it re adds all the files to the list. Anyway to only add names that don't exist in the list?

As for hyperlink I was able to make work, sort off. Using the Application.FollowHyperlink I can open the folder however using "" & Me.[FName])" at the end of the file path instaed of the folder name gives me error 490.
 
You need to concatenate the FPath & FName fields as a string.
Something like this...

Code:
Dim strPath As String

strPath="""" & Me.FPath & Me.FName & """" 

Application.FollowHyperlink strPath

NOTE: the 4x " quotes should give a " at start & another " at end
 
When I click on it now I get the security notice and in that window the path is show with the file name at the end so everything appears ok. However when I click open anyway I get error 490.
 
OK I've now tested that suggestion and agree about the error.
I'll think about how to solve that tomorrow if nobody else does so first.

In the meantime, you haven't said what type of file you want to look at.
Three suggestions:

1. If these are images in a folder, you could use my free image viewer app - see http://www.mendipdatasystems.co.uk/folder-image-viewer/4594429467

2. If you want to open files such as Excel or Word docs within Access, I have a file viewer app I can upload. If so, let me know

3. If however you want to open a file externally then I suggest you scrap the FollowHyperlink code and use this file handling code instead in a standard module. It should work in both 32-bit & 64-bit Access

Code:
Option Compare Database
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function apiShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" _
        (ByVal hWnd As LongPtr, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) _
        As LongPtr
#Else
    Private Declare Function apiShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" _
        (ByVal hWnd As Long, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) _
        As Long
#End If

Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 2            'Open Maximized
Public Const WIN_MIN = 3            'Open Minimized

Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

Function fHandleFile(stFile As String, lShowHow As Long)

On Error GoTo Err_Handler

Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
                
Exit_Handler:
    Exit Function
    
Err_Handler:
    MsgBox "Error " & Err.Number & " in fHandleFile procedure : " & Err.description, vbOKOnly + vbCritical
    Resume Exit_Handler

End Function

Now all you need to do is call the application with the path of the file and let Windows do the rest.
This code can be used to start any registered applications, including another instance of Access.
If it doesn't know what application to open the file with, it just pops up the standard "Open With.." dialog.

Open a folder:
fHandleFile("C:\TEMP",WIN_NORMAL)

Open a file:
fHandleFile("C:\TEMP\ExampleFile.docx",WIN_NORMAL)

Handle Unknown extensions:
fHandleFile("C:\TEMP\TestThis.xyz",Win_Normal)

It can even handle URL's and mailto:

Call Email app:
fHandleFile("mailto:bpo@yahoo.com",WIN_NORMAL)

Open URL:
fHandleFile("http://uk.yahoo.com";, WIN_NORMAL)

So you could use this code when you click on the concatenated file path&name

HTH
 
Maybe I should have started with what my end goal was. I have transferred my DVD collection to my PC and I'm trying to build sort of an interface to sort them. Genres and actors I will add manually and the will be able to apply filters based on different criteria. I was hoping I could launch the movie directly from Access. Originally I was going to do this in excel because I know excel a lot more than access. After recently starting to use access at work I thought this might be another option and could learn more about access at the same time.
 
It ALWAYS helps to say what the purpose is at the start
It would have saved several posts.

You could use the 3rd example I suggested above (fHandleFile) as it will run your DVD in the default application

Or you can try to use Access as a media player.

Attached is a work in progress that I haven't looked at in over a year. It was originally based on an app by another forum member from Greece (can't remember the name). i've used it to listen to MP3 and other music files as well as to watch video files.

Its by no means a finished app but perhaps you can adapt it to watch DVDs???
 

Attachments

Colin

Thank you for your time and help. Your last post got me to thinking. Surely in this day and age such a software must already exist. Not sure why I never though of searching for one before, however I have found one. It's called Eric's Movie Database and it's free. It does way more than I could ever dream of achieving with Access myself. I'm sure others could, however I don't think it's worth the time and effort with this already available. I will have to find another project to learn more about access. Thanks again and I'm sure I will be back:)
 
No problem. As its free, probably the best solution.
Again, as its not commercial software, perhaps you can provide a link in case anyone else is interested
 
Nobody seems to have objected so far.
If another moderator objects, that might of course change.

It would certainly be different if the link was promoting commercial software ...
If its good, I hope you will donate to support the author

However I know of another Access forum that will delete all such links on principle whether free apps or not ... so you were wise to be cautious
 
After testing if I continue using it I will definitely donate.
 

Users who are viewing this thread

Back
Top Bottom