Solved

Sort files in folder from Access using VBA

Posted on 2010-09-07
23
1,046 Views
Last Modified: 2013-11-27
Hi,

I am writing a program that uses Access as a database for some other applications and updates its data automatically by querying a folder for data files. These files are in a .csv format which have the data periods they represent in their filenames. All of the files are in the following format:

DtlDtl20100825.csv or DtlErr20100825.csv

so the last 8 digits hold the end date for the data in the file. I have written the code to access the files; however, I want to make sure that I read the files in sequential order from the earliest end date to the latest.

So what I would like to do is access the folder and sort the files by filename and then read them in sequential order form first to last. I believe that the code that I have written so far will read them in order from first to last but I'm unsure of how to sort the files first which is necessary to ensure that I don't delete the wrong files before they are read.

Here is the code that I am using to read the files.  Any other .csv files with different names are deleted.

Once the files are sorted then the following code should read them from first to last while deleting them after accessing the data.

Public Sub ImportFileMain()
Dim DtlDataInputFile As String, strSQL As String, DtlDataInputDataSource As String
Dim date_name As String, fiscper As Long, fiscyear As Long, lstimportfiscyear As Long, lstimportfiscper As Long
Dim Filedate As Date, lstimportdate As Date, lstimporterrdate As Date
Dim file_header As String
Dim dbsDtlReport As DAO.Database
Dim rst As DAO.Recordset

On Error GoTo leave:

        DtlDataInputDataSource = "C:\Projects\Company\VBA Tool\QA Data\"
        DtlDataInputFile = Dir("C:\Projects\Company\VBA Tool\QA Data\*.csv")
    
    Do While DtlDataInputFile <> ""
    
        'determine file_header from import file name
        file_header = Left(DtlDataInputFile, Len([DtlDataInputFile]) - 12)
    
    Select Case file_header
        Case Is = "DtlDtl"
    
             'determine date_name from import file name
             date_name = Left(Right([DtlDataInputFile], 12), 8)
             
             'Determine if file is a valid data input file and if so then
             If IsDate(Mid([date_name], 5, 2) & "/" & Right([date_name], 2) & "/" & Left([date_name], 4)) Then
             
                'Modify date_name from 20100825 format to 08/25/2010 format - also determine fiscal year
                 Filedate = CDate(Mid([date_name], 5, 2) & "/" & Right([date_name], 2) & "/" & Left([date_name], 4))
             
                'determine fiscal year and fiscal period by Querying Fiscal_Periods table
                fiscper = FiscalPeriod(Filedate)
                fiscyear = FiscalYear(Filedate)
                
                'Retreive the file date of the last import data file
                lstimportdate = LastImportDate()
                    
                'Retreive the number of the respective Fiscal Period for the last import data file
                lstimportfiscper = LastImportFiscPeriod()
                    
                'Retreive the number of the respective Fiscal Year for the last import data file
                lstimportfiscyear = LastImportFiscYear()
                    
                ' if date of import file is earlier than last imported file then delete
                If Filedate <= lstimportdate Then
                    Kill (DtlDataInputDataSource & DtlDataInputFile)
                    
                ' if date of import file is the same or later than last import file and fiscal period is the same then append data to main data table
                ElseIf Filedate > lstimportdate And fiscper = lstimportfiscper And fiscyear = lstimportfiscyear Then
                    Call TableData_Import(date_name, DtlDataInputDataSource, DtlDataInputFile)
                    
                    ' replace last import file specifications
                    CurrentDb.Execute "delete * from Current_FiscalPeriod_FiscalYear"
                    Call CurFiscPeriodFiscYear_Update(date_name, Filedate, fiscper, fiscyear)
                    
                ' if data of import file is the same of later than last import file and fiscal period is greater then run make tabel query
                ' and then delete main data table then append new file
                ElseIf Filedate > lstimportdate And fiscper > lstimportfiscper And fiscyear = lstimportfiscyear Then
                
                    ' replace Bar_AllData table with current Bar information
                    Call BarAllDataMakeTableQuery
                    
                    ' aggregate weekly data for fiscal period and create new table for current fiscal period and fiscal year
                    Call FiscalPeriodMakeTableQuery(fiscper, fiscyear)
                    
                    ' empty main data table
                    MainDataTableEmpty
                    
                    'append new fiscal period data to main data table
                    Call TableData_Import(date_name, DtlDataInputDataSource, DtlDataInputFile)
                    
                    ' replace last import file specifications
                    CurrentDb.Execute "delete * from Current_FiscalPeriod_FiscalYear"
                    Call CurFiscPeriodFiscYear_Update(date_name, Filedate, fiscper, fiscyear)
                    
                End If
             
             Else
                 Kill (DtlDataInputDataSource & DtlDataInputFile)
             End If
             
       Case Is = "DtlErr"
    
             'determine date_name from import file name
             date_name = Left(Right([DtlDataInputFile], 12), 8)
             
             'Determine if file is a valid data input file and if so then
             If IsDate(Mid([date_name], 5, 2) & "/" & Right([date_name], 2) & "/" & Left([date_name], 4)) Then
             
                 'Modify date_name from 20100825 format to 08/25/2010 format - also determine fiscal year
                 Filedate = CDate(Mid([date_name], 5, 2) & "/" & Right([date_name], 2) & "/" & Left([date_name], 4))
             
                'determine fiscal year and fiscal period by joining with Fiscal_Periods table
                fiscper = FiscalPeriod(Filedate)
                fiscyear = FiscalYear(Filedate)
                
                'Retreive the file date of the last import data file
                lstimporterrdate = LastImportErrDate()
                    
                ' if date of import file is earlier than last imported file then delete
                If Filedate <= lstimporterrdate Then
                    Kill (DtlDataInputDataSource & DtlDataInputFile)
                    
                ' if date of import file is the same or later than last import file and fiscal period is the same then append data to main data table
                ElseIf Filedate > lstimporterrdate Then
                    Call TableData_ErrImport(date_name, DtlDataInputDataSource, DtlDataInputFile)
                    
                    ' replace last import file specifications
                    CurrentDb.Execute "delete * from Current_Err_FiscalPeriod_FiscalYear"
                    Call CurErrFiscPeriodFiscYear_Update(date_name, Filedate, fiscper, fiscyear)
                    
                End If
             
             Else
                 Kill (DtlDataInputDataSource & DtlDataInputFile)
             End If
             
       Case Else
        
                Kill (DtlDataInputDataSource & DtlDataInputFile)
        
        End Select
    
        ' next file
        DtlDataInputFile = Dir
                 
    Loop
    
    ' update err data file
    Dtl_ErrMain_Update
        
    'compact database
    Call CompactCurrentDB
    
    Close
Exit Sub

leave:
    
End Sub

Open in new window


Your assistance in writing some VBA code to sort the files in the folder would be appreciated. I'm using MS Access 2007. Thanks.
 
0
Comment
Question by:scurvylion
  • 9
  • 7
  • 4
  • +1
23 Comments
 
LVL 31

Accepted Solution

by:
Helen_Feddema earned 300 total points
ID: 33619336
I don't see where you are doing any sorting in the code.  I think the best approach would be to retrieve the file names from this folder, using components of the FileSystemObject, stored them in a temp table in your database, and do the sorting there.  Then you could iterate through the table, and for each file, take the appropriate action with the corresponding file in the folder.  Here is some code to get file names from a folder and store them in a table:
Public Sub CopyCSVFilesToTable()

'Created by Helen Feddema 6-Sep-2010

'Last modified by Helen Feddema 6-Sep-2010



On Error GoTo ErrorHandler



   Dim fso As New Scripting.FileSystemObject

   Dim fld As Scripting.Folder

   Dim fil As Scripting.File

   Dim strSourcePath As String

   Dim strTable As String

   Dim strSQL As String

   Dim rst As DAO.Recordset

   

   strSourcePath = "G:\Documents\Job Files To Import"

   strTable = "tblFiles"

   strSQL = "DELETE * FROM " & strTable

   DoCmd.RunSQL strSQL

   

   Set fld = fso.GetFolder(strSourcePath)

   Set rst = CurrentDb.OpenRecordset(strTable)

   For Each fil In fld.Files

      Debug.Print fil.Name

      If Right(fil.Name, 3) = "csv" Then

         rst.AddNew

         rst![FileName] = fil.Name

         rst.Update

      End If

   Next fil



   rst.Close

   

ErrorHandlerExit:

   Exit Sub



ErrorHandler:

   MsgBox "Error No: " & Err.Number _

      & " in CopyCSVFilesToTable procedure; " _

      & "Description: " & Err.Description

   Resume ErrorHandlerExit



End Sub

Open in new window

0
 
LVL 10

Expert Comment

by:conagraman
ID: 33619432
here is a sample database where you can choose a folder and then list all of the files in the chosen folder. it seems it will list the files alphabetically automatically. it must be the default.

the code in the sample database below is set to filter and show only .csv files. if you wish to delete the non .csv files you will have to add that code. if you need help with that let me know.

hope this helps
listfiles.accdb
0
 
LVL 74

Assisted Solution

by:Jeffrey Coachman
Jeffrey Coachman earned 100 total points
ID: 33620752
Helen's code works wonderfully.
(I did modify the code silghtly, but you may want to leave it as is:

You can then use a query like this to display the files in "Numeric/Date" Order:

SELECT tblFiles.FileID, tblFiles.FileName, Right([FileName],12) AS DateString, IIf(IsNumeric(Left(Right([FileName],12),8)),Left(Right([FileName],12),8),"") AS DateSort
FROM tblFiles
WHERE (((Len(IIf(IsNumeric(Left(Right([FileName],12),8)),Left(Right([FileName],12),8),"")))>0))
ORDER BY IIf(IsNumeric(Left(Right([FileName],12),8)),Left(Right([FileName],12),8),"");

Then you can use a recordset loop to do something to each record in sequence

This can probably be simplified, but I always break thinks into the smallest pieces first, to see if it will work, then simplify later (when I know it works)

Here is the complete modified code (with proper credit give to Helen)

;-)

JeffCoachman

'Created by Helen Feddema 6-Sep-2010

'Last modified by Helen Feddema 6-Sep-2010

'(Altered slightly by Jeff Coachman 2010-09-07)



On Error GoTo ErrorHandler



Dim fso As New Scripting.FileSystemObject

Dim fld As Scripting.Folder

Dim fil As Scripting.File

Dim strSourcePath As String

Dim strTable As String

Dim strSQL As String

Dim rst As DAO.Recordset

Dim rstSort As DAO.Recordset

   

   strSourcePath = "C:\YourFolder"

   strTable = "tblFiles"

   strSQL = "DELETE * FROM " & strTable

   CurrentDb.Execute strSQL, dbFailOnError

   

   Set fld = fso.GetFolder(strSourcePath)

   Set rst = CurrentDb.OpenRecordset(strTable)

   For Each fil In fld.Files

      Debug.Print fil.Name

      If Right(fil.Name, 3) = "csv" Then

         rst.AddNew

         rst![FileName] = fil.Name

         rst.Update

      End If

   Next fil



   rst.Close

   Set rst = Nothing

   

    Set rstSort = CurrentDb.OpenRecordset("qrySortFileDates")

    rstSort.MoveFirst

    Do Until rstSort.EOF

        'Do Something

        MsgBox "File Name: " & rstSort!FileName & vbCrLf & "Sort String: " & rstSort!DateSort

        rstSort.MoveNext

    Loop

    

    rstSort.Close

    Set rstSort = Nothing

    

ErrorHandlerExit:

   Exit Sub



ErrorHandler:

   MsgBox "Error No: " & Err.Number _

      & " in CopyCSVFilesToTable procedure; " _

      & "Description: " & Err.Description

   Resume ErrorHandlerExit

Open in new window

0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 33620763
0
 
LVL 10

Expert Comment

by:conagraman
ID: 33621030
Hellen’s code is nice however I would say my alternative is more efficient. Eliminating the need for a table or query.  Also eliminating the need to hard code a path.
0
 
LVL 10

Assisted Solution

by:conagraman
conagraman earned 100 total points
ID: 33621204
scurvylion

here is a new sample database. i added to my database. this will delete all files that do not end in csv in the selected folder.

hope this helps
listfiles2.accdb
0
 
LVL 31

Expert Comment

by:Helen_Feddema
ID: 33621298
I figured that the file path location was constant -- if it varies, this function can be used to browse for it:
Public Function SelectFolder() As String

'Requires Office XP (2002) or higher

'Requires a reference to the Microsoft Office Object Library

'Created by Helen Feddema 3-Aug-2009

'Last modified 3-Aug-2009



On Error GoTo ErrorHandler



   Dim strFolderPath As String

   Dim fd As Office.FileDialog

   Dim strPath As String



   'Create a FileDialog object as a Folder Picker dialog box.

   Set fd = Application.FileDialog(msoFileDialogFolderPicker)



   'Set strPath to the folder you want to open initially

   strPath = "G:\Data"



   With fd

      .Title = "Browse for folder where _________ are located"

      .ButtonName = "Select"

      .InitialView = msoFileDialogViewDetails

      '.InitialFileName = strPath

      If .Show = -1 Then

         strFolderPath = CStr(fd.SelectedItems.Item(1)) & "\"

      Else

         Debug.Print "User pressed Cancel"

         strFolderPath = ""

      End If

   End With



   SelectFolder = strFolderPath

   

ErrorHandlerExit:

   Exit Function



ErrorHandler:

   MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description

   Resume ErrorHandlerExit



End Function

Open in new window

0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 33621346
Yes, conagraman, your code works great also.

I used Helen's code as you had not posted yours as of that time.
I also, personally, like the idea of storing the values in a static table for persistence reasons...

But as always, there is no right or wrong here.
;-)

You might also want to filter out FileNames that are not numeric in the last 8 characters...

<So what I would like to do is access the folder and sort the files by filename and then read them in sequential order form first to last. I believe that the code that I have written so far will read them in order from first to last>
In this context, it is not clear what "Read" means specifically, (Display or Process) that is why I tacked on simple code to loop the records.
If they want them displayed then they can do something simple like this:
    Docmd.openQuery "SomeQueryName"
To display the query.

We will have to wait for the Asker to chime back in to clarify.

;-)

Jeff
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 33621385
scurvylion, Helen

Just to be clear, I will only accept points for my post if:
1. You actually wanted the sorted query and the recordset loop included in your solution.
2. Helen is given the Lionshare of the points for the original code.

;-)

Jeff
0
 
LVL 10

Expert Comment

by:conagraman
ID: 33621461
it would appear Helen doesn’t need any help from anyone and probably doesn’t want anyone modifying anything she has put thought and effort into.

just to be clear my code is completely different from miss helen. Also it does everything the author asked. The lion share of the points should go to myself or Helen if you do prefer her solution.  
0
 
LVL 10

Expert Comment

by:conagraman
ID: 33621491
excuse me boag2000: i didnt see your post 33621346.  
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 10

Expert Comment

by:conagraman
ID: 33621535

perhaps you will agree with me then boag2000

i happen to like helens last post in using the office dialog. i believe if the code was modified to include code to kill the non csv files in the directory it would be 100%.
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 33621830
No problem...
;-)

For the record, I have had the honor of posting alongside Helen for over a year now, and she is the consummate professional.
In that time, we have worked in concert on countless questions with no ill will between us.
;-)

I used her code because:
1. I would have done something similar anyway.
2. I wanted to show that her code was of such High quality that another Expert could use it to perhaps demonstrate a bit more.
3. I gave Helen full credit in this thread, in the code, and the sample, ...for the original code.
(If it be her will, ...I will even forgo any points for my post)


Finally, again, we still have not heard from the Asker to clarify any of our concerns about anything beyond sorting the files by the date string.

As I said before, at our level, there really is no right or wrong way to do anything.

Based on each of us interpreting the askers request, we may have different takes of what the solution might look like.

We all bring our unique skills, individual experiences and preferences to this site.
Which will always serve to make the "Member Experience" that much richer, regardless of who gets the credit or points.

;-)

Jeff
0
 

Author Comment

by:scurvylion
ID: 33627514
Hi guys,
Sorry to take so long to get back t you. Unfortunately, I had to put out some fires elsewhere and could not devote any time to this problem until now.

I ended up using Helen's code with Jeff's sort procedure which I modifed slightly to suit my purposes. I did actually want the sort procedure as well as there was no sorting done in the original code that I posted ( as Helen noted). So I am going to split the points between both of you.

Conagraman - I hadn't had a chance to get back to this question until right now and I had already modified Helen and Jeff's code to suit my purposes. Therefore, I didn't have the opportunity to evaluate your solution; however, I will do so now. Thanks for your efforts as well.

I want to thank everyone that contributed to this question and to let you know that I greatly appreciate your time and efort.

The code that I ended up with is as follows:

[code]
Public Sub CopyCSVFilesToTable2()

'Created by Helen Feddema 6-Sep-2010
'Last modified by Helen Feddema 6-Sep-2010
'(Altered slightly by Jeff Coachman 2010-09-07)

On Error GoTo ErrorHandler

Dim fso As New Scripting.FileSystemObject
Dim fld As Scripting.Folder
Dim fil As Scripting.File
Dim strSourcePath As String
Dim strTable As String
Dim strSQL As String, strSRC As String
Dim rst As DAO.Recordset, rs As DAO.Recordset
Dim rstSort As DAO.Recordset, rsSort As DAO.Recordset
   
   strSourcePath = "G:\AAA\Company\VBA Tool Project\QA Data\"
   strTable = "tblFiles"
   strSQL = "DELETE * FROM " & strTable
   CurrentDb.Execute strSQL, dbFailOnError
   
   Set fld = fso.GetFolder(strSourcePath)
   Set rst = CurrentDb.OpenRecordset(strTable)
   Set rs = CurrentDb.OpenRecordset(strTable)
   
   For Each fil In fld.Files
      Debug.Print fil.Name
      If Right(fil.Name, 3) = "csv" Then
         rst.AddNew
         rst![FileName] = fil.Name
         rst.Update
      End If
   Next fil

   rst.Close
   Set rst = Nothing
   
   strSRC = "SELECT tblFiles.FileName, Right([FileName],12) AS Datestring, (IIf(IsNumeric(Left(Right([FileName],12),8)),Left(Right([FileName],12),8),)) AS DateSort " _
            & "FROM tblFiles " _
            & "WHERE ((Len(IIf(IsNumeric(Left(Right([FileName],12),8)),Left(Right([FileName],12),8),)) > 0)) " _
            & "ORDER BY (IIf(IsNumeric(Left(Right([FileName],12),8)),Left(Right([FileName],12),8),)) "

        Set rst = CurrentDb.OpenRecordset(strSRC)
       
            'Begin row processing - do not process if end-of-file reached
            Do While Not rst.EOF
           
            'Retreive the name of the respective Fiscal Period for the last import data file
        MsgBox "File Name: " & rst!FileName & vbCrLf & rst!DateSort
            rst.MoveNext
            Loop
           
            If rst.EOF And rst.BOF Then
            Exit Sub
            End If
   
    rst.Close
    Set rst = Nothing
   
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in CopyCSVFilesToTable procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit
   
End Sub
[/code]

scurvylion
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 33628410
FWIW,

I did try conagraman's sample and it too, worked wonderfully.

I can't force your hand, but you can always re-open this Q and split the points 3 ways.
This is because:
1. All of out posts addressed the issue in your original post
2. They all have been proven to work.
3. A person searching here for the same issue might find value in conagraman's post, as a different interface was used.

;-)

JeffCoachman
0
 

Author Comment

by:scurvylion
ID: 33628958
Hi,

That's probably a good idea. The reason that I didn't was that I had already used Helen and your input to write the code.

How do I re-open it and split the points?

scurvylion
0
 

Author Comment

by:scurvylion
ID: 33629062
I have made a request to split the points 3 ways. Since Helen ws the first to answer and addressed the majority of my question, I have given her the lion's share.

New split
Helen_Feddema: 300 points
boaq2000: 100 points
conagraman: 100 points

Thanks for your input. I hope that I haven't caused any problems with my actions. Please accept my apologies.

I sincerely appreciate all of the help I have received on EE from everyone.

scurvylion
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 33629618
No problems AFAIC...

;-)

Jeff
0
 

Author Closing Comment

by:scurvylion
ID: 33631857
Thanks again for everyone's help.
scurvylion
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 33633046
;-)
0
 
LVL 10

Expert Comment

by:conagraman
ID: 33633374
scurvylion

thank you for your consideration.

boag2000: i do appreciate your comments.

thank you
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 33633413
;-)
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Suggested Solutions

Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now