open files in loop with date order

  • Thread starter Thread starter sajjad.kaswani1
  • Start date Start date
S

sajjad.kaswani1

Hello

how are you


i am using Excel 2002,

i want to know is there any way to Open Files one by one from a Folder

my files names are actuly based on dates

like

01-Jan-02
02-Jan-02
.....
......
..
..


11-Jan-02

..
...
.....


i have a code which i'll apply when that file open

but dont know how to do above task


please kindly help me out

thanks,
 
And Hello to you too,

This is a method that I have used. It requires copying the file names to a
worksheet and extracting the date component to a separate column and then
sorting the filename and date column. Then looping through the sorted file
names.

Just a little extra advice, if you are going to use dates for file names
then I find it is better to put them in yyyy-mm-dd format for the file name.
This way they can be ordered by file name in the file open dialog box.
However, the macro below works with the date format dd-mm-yy that you said
has been used.

If you have any problems with it then feel free to get back to me

Sub LoopFileOpen()
Dim strPath As String
Dim wsSht2 As Worksheet
Dim strFileName As String
Dim i As Single
Dim rngSort As Range
Dim rngFileNames As Range
Dim f As Range
Dim strThisWB As String

strThisWB = ThisWorkbook.Name

Set wsSht2 = Sheets("Sheet2")
wsSht2.Columns("B:B").NumberFormat = "d/m/yyyy"
wsSht2.Cells(1, 1) = "File Name"
wsSht2.Cells(1, 2) = "Date"

strPath = CurDir 'Set strPath this to the required path
With Application.FileSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
strFileName = Mid(.FoundFiles(i), _
InStrRev(.FoundFiles(i), "\") + 1)
If strFileName <> strThisWB Then
wsSht2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) _
= strFileName
wsSht2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) _
= DateValue(Left(strFileName, _
InStr(1, strFileName, ".") - 1))
End If
Next i
Else
MsgBox "There were no files found."
End If
End With

With wsSht2
Set rngSort = Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(xlUp))
End With

rngSort.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Set rngFileNames = wsSht2.Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))

For Each f In rngFileNames
Workbooks.Open Filename:=f.Value
'Delete msgbox and put your code here
'(or call another procedure)
MsgBox "File opened is " & f.Value
Next f


End Sub


Regards,

OssieMac
 
This code is a little simplier than OssieMac solution. It reads the files
names into an array and then sorts the array. The code is case sensitive.
If you don't care about the case the make this replacement
from
FileNames(FileCount) = Filename
to
FileNames(FileCount) = ucase(Filename)

Sub sortfilename()

Const MyPath = "c:\temp"
Const Filetype = "*.xls"
Dim FileNames(1000)

FileCount = 0
First = True
Do
If First = True Then
Filename = Dir(MyPath & "\" & Filetype)
First = False
Else
Filename = Dir()
End If

If Filename <> "" Then
FileNames(FileCount) = Filename
FileCount = FileCount + 1
End If
Loop While Filename <> ""

'sort file names
FileCount = FileCount - 1
For i = 0 To (FileCount - 1)
For j = i To FileCount
If FileNames(i) > FileNames(j) Then

temp = FileNames(i)
FileNames(i) = FileNames(j)
FileNames(j) = temp
End If
Next j
Next i

'open files
For i = 0 To (FileCount - 1)
Workbooks.Open MyPath & "\" & FileNames(i)

'Enter Your code here
Workbooks(FileNames(i)).Close
Next i
End Sub
 
I like the array idea Joel but in its current form it does not work. I
interpreted the OP's post as wanting to sort the filenames so that the date
names were sorted as dates. Your method sorts them as text and not in the
date order. You have a date like 05-Sep-07 coming before 06-Aug-07.

When I originally had to extract files like this I actually started with an
array. However, I ran into problems sorting with the filenames being strings
and the user wanting them sorted as dates.

I then tried extracting the filename to left of the dot and saving as
DateValue(filename) and using Format(array(i),"dd-mm-yy") to convert it back
to a string for the filename. This also failed because we had a user who
saved some files as d-mm-yy. I moved to the method of copying the data to a
worksheet so that I could see what was happening and I created a separate
date column to achieve the correct sorting and retain the original text file
name and then when it all worked, I left it that way.

Maybe a 2 dimensional array is the answer but I haven't tried it.

Regards,

OssieMac
 
Your assuption is that files files were modified as the names of the files.
Often people modified the files. Using the date value function would solve
the problem.

change the compare in the sort
from
If FileNames(i) > FileNames(j) Then
to
If datevalue(FileNames(i)) > datevalue(FileNames(j)) Then


the real solution to the problem is your suggestion. Whenever files are
name include a date in the format YYYY-MM-DD.

Joels Monthly Report 2007-02-05
Joels Monthly Report 2007-03-01
Joels Monthly Report 2007-04-02
 
Hi Joel and also to the OP,

I am really impressed with Joel's input and particularly his last idea for
sorting the datevalues. Overall it is a far better solution, particularly
since FileSearch is no longer supported in xl2007. However, the datevalues
needed another little tweek because the array holds the entire filename
including the .xls ext. I have done this and also included a test for
thisworkbook so that it gets left out of the file list if it just happens to
be in the same folder.

Note that the code should now work for most formats of the date as a
filename even if they are mixed formats such as d-mmm-yy, dd-mm-yyyy.
However, the emphasis is on 'should' because I have not tested it to the nth
degree. The date formats in the original post of dd-mmm-yy should never give
any problems.

Here is a fresh copy of the code with the amendments:-

Sub sortfilename()

Const MyPath = "c:\temp"
Const Filetype = "*.xls"
Dim FileNames(1000)

Dim strThisWb As String

strThisWb = ThisWorkbook.Name
FileCount = 0
First = True
Do
If First = True Then
Filename = Dir(MyPath & "\" & Filetype)
First = False
Else
Filename = Dir()
End If

'Leave out this workbook that contains the macro
If Filename <> "" And Filename <> strThisWb Then
FileNames(FileCount) = Filename
FileCount = FileCount + 1
End If
Loop While Filename <> ""

'sort file names
FileCount = FileCount - 1
For i = 0 To (FileCount - 1)
For j = i To FileCount
If DateValue(Left(FileNames(i), InStr(FileNames(i), ".") - 1)) _
DateValue(Left(FileNames(j), InStr(FileNames(j), ".") - 1)) Then
Click to expand...
temp = FileNames(i)
FileNames(i) = FileNames(j)
FileNames(j) = temp
End If
Next j
Next i

'open files
For i = 0 To (FileCount - 1)
'MsgBox only for testing. Delete it and
'remove comment from the following 3 lines
MsgBox FileNames(i)
'Workbooks.Open MyPath & "\" & FileNames(i)
'Enter Your code here
'Workbooks(FileNames(i)).Close
Next i

End Sub

Thanks again Joel for you input here.

Regards,

OssieMac
 
Back
Top