I have tried to do some research but with no luck. I am trying to
create a macro that will open the most recent file with particular
filename strings. Another team saves files to a shared directory with
the following filenames:
TEST_1.DDMMYYYYHHMM
TEST_2.DDMMYYYYHHMM
The issue is that there may be days that there are no files and there
may be days with multiple files. This is what I have thus far:
Dim testfile as string
Dim count as integer
testfile="TEST_1"
count=1
Application.FileSearch
.NewSearch
.LookIn = "B:\"
.SearchSubFolders = False
.FileName = testfile
.Execute
Do Until count .FoundFiles.Count
If Format(FileDateTime(.FoundFiles(testfile)), "MM/DD/YYYY") <
Format(date, "MM/DD/YYYY") Then
Set wb = Workbooks.Open(FileName:=.FoundFiles(testfile),
ReadOnly:=True)
End If
Count=count+1
loop
End With

I think I'm about to go crazy.... any help will be greatly
appreciated!!


--
kwiklearner
------------------------------------------------------------------------
kwiklearner's Profile: http://www.excelforum.com/member.php...o&userid=31909
View this thread: http://www.excelforum.com/showthread...hreadid=574388

First, I think your life would be simpler if you used:
test_#.yyyymmddhhmm.xls
as your file name. Then you wouldn't have to parse that date. You could just
look at the numeric portion and keep the file with the largest "date/time".

Second, you could use application.filesearch and sort by the most current--if
you could trust the file's last updated date/time. Then you could just pick out
the first file (at top of the list).

Option Explicit
Sub testme()

Dim i As Long

With Application.FileSearch
.LookIn = "C:\My Documents\excel"
.Filename = "*.xls"
.SearchSubFolders = False
If .Execute(SortBy:=msoSortByLastModified, _
SortOrder:=msoSortOrderDescending) 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
'do something with .foundfiles(1)
'or just show the order that was found
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With

End Sub


==========
But I _think_ that this works ok.

Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook

Dim myFileName As String
Dim myFileDate As Date
Dim myFileCtr As Long

Dim myDateStr As String

Dim LooksLikeADateTime As Boolean

Dim MostCurrentFileName As String
Dim MostCurrentFileDate As Date
Dim MostCurrentFileCtr As Long

Dim DotPos As Long
Dim UnderScorePos As Long

'change to point at the folder to check
myPath = "C:\my documents\excel\test"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

Application.ScreenUpdating = False

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

MostCurrentFileName = ""
MostCurrentFileDate = 0
MostCurrentFileCtr = 0
'TEST_1.DDMMYYYYHHMM.xls

If fCtr 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
'look for underscore
UnderScorePos = InStr(1, myNames(fCtr), "_", vbTextCompare)
'remove the .xls stuff
myDateStr = Left(myNames(fCtr), Len(myNames(fCtr)) - 4)
'find the . after test_#.
DotPos = InStr(1, myDateStr, ".", vbTextCompare)
If DotPos 0 _
And UnderScorePos 0 _
And (DotPos UnderScorePos) Then
'remove the Test_. junk
myFileCtr = Mid(myNames(fCtr), UnderScorePos + 1, _
DotPos - UnderScorePos - 1)
myDateStr = Mid(myDateStr, DotPos + 1)
If IsNumeric(myDateStr) _
And Len(myDateStr) = 12 _
And IsNumeric(myFileCtr) Then
LooksLikeADateTime = True
'try to make it a date/time
On Error Resume Next
'ddmmyyyyhhmm
myFileDate = DateSerial(Mid(myDateStr, 5, 4), _
Mid(myDateStr, 3, 2), _
Mid(myDateStr, 1, 2)) _
+ TimeSerial(Mid(myDateStr, 9, 2), _
Mid(myDateStr, 11, 2), _
0)
If Err.Number < 0 Then
'not a real date/time--skip it!
LooksLikeADateTime = False
Err.Clear
End If
On Error GoTo 0

If LooksLikeADateTime = True Then
If (myFileDate MostCurrentFileDate) _
Or ((myFileDate = MostCurrentFileDate) _
And (myFileCtr MostCurrentFileCtr)) Then
MostCurrentFileDate = myFileDate
MostCurrentFileName = myNames(fCtr)
MostCurrentFileCtr = myFileCtr
End If
End If
End If
End If
Next fCtr
End If

If MostCurrentFileName = "" Then
MsgBox "no files matched that naming convention!"
Else
MsgBox MostCurrentFileName & vbLf _
& Format(MostCurrentFileDate, "yyyy/mm/dd hh:mm:ss")
Set wkbk = Workbooks.Open(Filename:=myPath & MostCurrentFileName)
End If

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub



kwiklearner wrote:

I have tried to do some research but with no luck. I am trying to
create a macro that will open the most recent file with particular
filename strings. Another team saves files to a shared directory with
the following filenames:
TEST_1.DDMMYYYYHHMM
TEST_2.DDMMYYYYHHMM
The issue is that there may be days that there are no files and there
may be days with multiple files. This is what I have thus far:
Dim testfile as string
Dim count as integer
testfile="TEST_1"
count=1
Application.FileSearch
NewSearch
LookIn = "B:\"
SearchSubFolders = False
FileName = testfile
Execute
Do Until count .FoundFiles.Count
If Format(FileDateTime(.FoundFiles(testfile)), "MM/DD/YYYY") <
Format(date, "MM/DD/YYYY") Then
Set wb = Workbooks.Open(FileName:=.FoundFiles(testfile),
ReadOnly:=True)
End If
Count=count+1
loop
End With

I think I'm about to go crazy.... any help will be greatly
appreciated!!

--
kwiklearner
------------------------------------------------------------------------
kwiklearner's Profile: http://www.excelforum.com/member.php...o&userid=31909
View this thread: http://www.excelforum.com/showthread...hreadid=574388

--

Dave Peterson