Results 1 to 5 of 5
  1. #1
    aheard is offline Novice
    Windows 7 64bit Access 2007
    Join Date
    Mar 2017
    Posts
    2

    Using Dir$ to get file names from a directory gives runtime error 2471

    I'm trying to get a module to scrape the file name and last modified date for files in a given directory, and if the file names are not already in a given table, add new records for each new file name. I started with a module posted by CARDA Consultants Inc, 2007-01-19 here, and modified heavily.

    I haven't even touched the last modified portion, because I can't even get the filename import to function. I constantly get runtime error 2471 with a description "The expression you entered as a query parameter produced this error: 'filename.pdf' ", where filename.pdf is the name of an actual file in the directory I'm trying to scrape. Always that same filename every time I run this function.

    Code:
    Public Function GetFiles()
    
    On Error GoTo Error_Handler
     
    Dim MyFile  As String
    Dim MyFileDate As Date
    Dim db      As Database
    Dim sSQL    As String
    Dim strPath As String
    Dim strFilter As String
    
    
    'Dir can't seem to handle a direct network path, so had to use the drive letter it's mapped to
    strPath = "L:\Clinicals\Files\"
    strFilter = "*"
     
    Set db = CurrentDb()
     
    'Loop through all the files in the directory by using Dir$ function
    MyFile = Dir$(strPath & "*")
    
    Do While MyFile <> ""
    
    'Added the If and DCount to original code to skip already added files
    If DCount("[filename]", "tbl-Clinicals", MyFile) > 0 Then
        sSQL = "INSERT INTO [tbl-Clinicals] (filename) VALUES(""" & MyFile & """)"
        db.Execute sSQL, dbFailOnError
        End If
        MyFile = Dir$
    Loop
     
    Error_Handler_Exit:
        On Error Resume Next
        Set db = Nothing
        Exit Function
     
    Error_Handler:
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: GetFiles" & vbCrLf & _
               "Error Description: " & Err.Description, vbCritical, _
               "An Error has Occured!"
        Resume Error_Handler_Exit
    
    End Function
    In case you're curious why anyone would ever need such a horrible module, we have a large, contracting organization who sends us scanned documents for people we're working with via an FTP, but refuses to include identifying info in the file names. I used to manually copy them from one folder to another, then open each file, and view the contents to rename the file something connected to the person. This was extremely laborious, so instead I built this convoluted Access app. I first use a scheduled task to copy the files to a shared drive accessible by our entire team, and then add the new filenames to the table using an import. I'm trying to get this module to automatically add the new filenames and last modified dates to further save quite a bit of time in this truly ridiculous process.

  2. #2
    ranman256's Avatar
    ranman256 is offline VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    9,521
    use file system object to get files in folder

    Code:
      'submit the starting folder
    '---------------
    Public sub ScanFilesInDir(byval pvDir) 
    '---------------
    Dim vFil, vTargT
    Dim i As Integer
    Dim fso
    Dim oFolder, oFile
    Dim vSrc
    dim pvDir
    dim colFiles as new collection
    
    On Error GoTo errImp
    
    if isNull(pvDir) then exit sub
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fso.GetFolder(pvDir)
    
    For Each oFile In oFolder.Files
        vFil = pvDir & oFile.Name
    
        If InStroFile.Name".pdf") > 0   Then      'ONLY DO pdf files
               vSrc = pvDir & oFile.Name 
    
                            'do something with the file                    
               msgbox vSrc               
        End If
    Next
    
    
    Set fso = Nothing
    Set oFile = Nothing
    Set oFolder = Nothing
    Exit function
    
    errImp:
    MsgBox Err.Description, vbCritical, "clsImport:ImportData()" & Err
    Exit function
    Resume
    End sub

  3. #3
    kemas is offline Novice
    Windows 7 32bit Access 2007
    Join Date
    Jul 2011
    Posts
    6
    Quote Originally Posted by ranman256 View Post
    use file system object to get files in folder

    Code:
      'submit the starting folder
    '---------------
    Public sub ScanFilesInDir(byval pvDir) 
    '---------------
    Dim vFil, vTargT
    Dim i As Integer
    Dim fso
    Dim oFolder, oFile
    Dim vSrc
    dim pvDir
    dim colFiles as new collection
    
    On Error GoTo errImp
    
    if isNull(pvDir) then exit sub
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fso.GetFolder(pvDir)
    
    For Each oFile In oFolder.Files
        vFil = pvDir & oFile.Name
    
        If InStroFile.Name".pdf") > 0   Then      'ONLY DO pdf files
               vSrc = pvDir & oFile.Name 
    
                            'do something with the file                    
               msgbox vSrc               
        End If
    Next
    
    
    Set fso = Nothing
    Set oFile = Nothing
    Set oFolder = Nothing
    Exit function
    
    errImp:
    MsgBox Err.Description, vbCritical, "clsImport:ImportData()" & Err
    Exit function
    Resume
    End sub
    what we need to make this work?

  4. #4
    aheard is offline Novice
    Windows 7 64bit Access 2007
    Join Date
    Mar 2017
    Posts
    2

    Updated code

    Thanks, ranman256. This method allowed me to use the network drive full path, rather than having to use a mapped drive letter, which could've made it difficult for other people to use who don't have it mapped to the same letter, and I was able to use the code you provided, with some modifications:

    Code:
    'submit the starting folder
    '---------------
    'Changed to function, since was causing error with Exit Function later
    Public Function ScanFilesInDir(ByVal pvDir)
    '---------------
    Dim vFil, vTargT
    Dim vDate As Date
    Dim i As Integer
    Dim fso As Object
    Dim oFolder, oFile
    Dim vSrc
    Dim colFiles As New Collection
    'Added SQL variabel since I'm using to addend to a table.
    Dim sQL As String
    
    
    On Error GoTo errImp
    
    
    If IsNull(pvDir) Then Exit Function
    
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fso.GetFolder(pvDir)
    
    
    For Each oFile In oFolder.Files
        vFil = oFile.Name 'pvDir & oFile.Name
    'Added date last modified variable
        vDate = oFile.DateLastModified
        vSrc = pvDir & oFile.Name
    
    
    'do something with the file
    'Used the sSQL string to insert into the table
        sSQL = "INSERT INTO [tbl-Clinicals] (filename,docdate) VALUES(""" & vFil & """, """ & vDate & """)"
        DoCmd.RunSQL (sSQL)
    
    
    Next
    
    
    
    
    Set fso = Nothing
    Set oFile = Nothing
    Set oFolder = Nothing
    Exit Function
    
    
    errImp:
    MsgBox Err.Description, vbCritical, "clsImport:ImportData()" & Err
    Exit Function
    Resume
    End Function
    The above got me a lot further than previous. At this point the only problems are the following:
    For a large batch of new files, I have to approve each append query
    How do I skip files already added to the table?

    For the first, is there some way to create a temporary recordset, so I could add each to that, then append all at once?
    For the second, I tried to use the following, but ran into issues with where to place the End If:
    Code:
    If DCOUNT("[filename]", "tbl-Clinicals", oFile.Name) > 0 Then Resume Next

  5. #5
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    For a large batch of new files, I have to approve each append query
    Suggest you use the .Execute method of the CurrentDb object. There is a dbFailOnError parameter that you may want to make use of to trap the error that I presume will be raised if you try to add a record that already exists because you've set an index to be unique. So if you get that error, you would resume next to apply the Next line for your loop. Be careful to save any code work before running your procedure. Natch, you will watch out for the possibility that you can create an endless loop when using error handling, but there's not much worse than altering a bunch of code and running it, only to find you have to force a shutdown due to a loop that can't be escaped.

    You can't batch write edits to a recordset, you can only update one at a time. The effect could appear to be a batch operation though.
    The more we hear silence, the more we begin to think about our value in this universe.
    Paraphrase of Professor Brian Cox.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Runtime Error 2471
    By Thompyt in forum Programming
    Replies: 9
    Last Post: 12-29-2016, 04:56 PM
  2. File Directory in VBA
    By RayMilhon in forum Programming
    Replies: 1
    Last Post: 05-11-2016, 01:06 PM
  3. Replies: 1
    Last Post: 08-15-2015, 10:09 AM
  4. Runtime error 3436 Failure Creating File
    By cuddles in forum Access
    Replies: 13
    Last Post: 07-21-2014, 08:03 AM
  5. Replies: 6
    Last Post: 06-15-2011, 04:38 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums