Link to home
Start Free TrialLog in
Avatar of Seamus2626
Seamus2626Flag for Ireland

asked on

Amend code

Hi,

I have some code that opens the latest file from a specified folder (with various months e.g. Mar,Apr,May,June etc)

Can this code be amended so that it opens the latest file from the previous months folder. So if it was ran today it would open the latest xls file from April.

Thanks
Seamus
ub OpenLatestFile()
   Dim initPath As String, Direc As String, strFile As String, strFinalFile As String
   Dim DT As Date, dteFile As Date
   Dim objFSO, objFdr, objSubFdr
   
   ' Change Path of parent directory here
   ' Don't forget the "\" after the path
   initPath = "\\ukhibmdata02\S-gdata\EVERYONE\Ops to PC folders\Div Rec Email\2011\"
   
   
   
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFdr = objFSO.getfolder(initPath)
   
   ' loop through folders, checking names
   For Each objSubFdr In objFdr.subfolders
      If IsDate(objSubFdr.Name) Then
          If DT = #12:00:00 AM# Then
            DT = CDate(objSubFdr.Name)
            Direc = objSubFdr.Name
         Else
            If CDate(objSubFdr.Name) > DT Then
               DT = CDate(objSubFdr.Name)
               Direc = objSubFdr.Name
            End If
         End If
      End If
   Next objSubFdr
   ' check we found a date
   If Len(Trim(Direc)) <> 0 Then
      ' now need to loop through the files and find the last one
      ' assumes file names are like "09022011 Merit.xls"
      ' so we want the first 8 characters converted to a date
      strFile = Dir(initPath & Direc & "\*.xls")
      If strFile <> "" Then
         Do
            If dteFile < GetDateFromFileName(strFile) Then
               strFinalFile = strFile
               strFile = Dir
            End If
         Loop While strFile <> ""

         If Len(strFinalFile) > 0 Then
           Workbooks.Open initPath & Direc & "\" & strFinalFile
           Sheets("Current breaks").Visible = True
           Sheets("Current breaks").Select
         End If
         
         
      Else
         MsgBox "No workbooks in " & initPath & Direc & "\"
      End If
   Else
      MsgBox "No date files found"
   End If
End Sub


Function GetDateFromFileName(strFile As String) As Date
   ' returns date from last 8 characters of file name
   ' assumes ddmmyyyy format
   Dim dteTemp As Date, strTemp As String
   strTemp = Right$(Replace$(strFile, ".xls", "", , , vbTextCompare), 8)
   If Len(strTemp) < 8 Then Exit Function
   strTemp = Left$(strTemp, 2) & "/" & Mid$(strTemp, 3, 2) & "/" & Mid$(strTemp, 5, 4)
   If IsDate(strTemp) Then GetDateFromFileName = CDate(strTemp)
End Function

Open in new window

Avatar of jppinto
jppinto
Flag of Portugal image

I don't know how you folders are named but if they are named like "Jan", "Feb", etc, you just need to change this like:

initPath = "\\ukhibmdata02\S-gdata\EVERYONE\Ops to PC folders\Div Rec Email\2011\"

to this:

initPath = "\\ukhibmdata02\S-gdata\EVERYONE\Ops to PC folders\Div Rec Email\2011\" & Format(Month(Now()), "mmm")

jppinto
Avatar of Seamus2626

ASKER

Hey jppinto, the folders are named

03 Mar, 04 Apr, 05 May etc

(For some reason, the number of the month is put before the text!)
So just change to this:

initPath = "\\ukhibmdata02\S-gdata\EVERYONE\Ops to PC folders\Div Rec Email\2011\" & Format(Month(Now()), "dd") & " " & Format(Month(Now()), "mmm")

it will give you folder names like

12 May
ASKER CERTIFIED SOLUTION
Avatar of Rory Archibald
Rory Archibald
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks Jppinto but i got errors on that code, it couldnt find the Initial Path

Thanks Rory that worked perfectly

Cheers,
Seamus
Replace lines 17-27 with

      If IsDate(objSubFdr.Name) Then
      If Format(CDate(objSubFdr.Name), "mmmyyyy") = _
        Format(DateSerial(Year(Date), Month(Date), 1), "mmmyyyy") Then
          If DT = #12:00:00 AM# Then
            DT = CDate(objSubFdr.Name)
            Direc = objSubFdr.Name
         Else
            If CDate(objSubFdr.Name) > DT Then
               DT = CDate(objSubFdr.Name)
               Direc = objSubFdr.Name
            End If
         End If
      End If
      End If
OOPs accepted already
@jppinto,
The key is the weird naming convention for Seamus' folders - it's always the month number and name - i.e. 05 MAY is month 5, not day 5, so there's only one folder per month.