Adding to code

Hi,

I have attached some code (Rory kindly provided me) that gets the latest file from the latest month folder.

I need some adjusting.

The month part is irrelavant in this case. I just need the latest file from a specific folder.

The folder is called

G:\Asset Services Risk Team\cmFiscalrecTool\From_CM

However, the date in these files is in the middle of the file name (bolded)

i.e. ReconReport_20110309_21033800_.CSV

So i need the code to take account of the fact that its calling the latest file from a date thats in the middle!!

Thanks
Seamus
Sub OpenLatestFilePayRecLegacy()
   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\rights\Asset Services MI\Payable & Receivable\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
              
            End If
            
             strFile = Dir
            
         Loop While strFile <> ""


         If Len(strFinalFile) > 0 Then
           Workbooks.Open initPath & Direc & "\" & strFinalFile
           Sheets("Monitor").Visible = True
           Sheets("Monitor").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

Seamus2626Asked:
Who is Participating?
 
Rory ArchibaldConnect With a Mentor Commented:
Try this:
Sub OpenLatestFilePayRecLegacy()
   Dim initPath As String, Direc As String, strFile As String, strFinalFile As String
   Dim DT As Date, dteFile As Date
   
   ' Change Path of parent directory here
   ' Don't forget the "\" after the path
   initPath = "G:\Asset Services Risk Team\cmFiscalrecTool\From_CM\"
   
   ' now need to loop through the files and find the last one
   ' assumes file names are like "ReconReport_20110309_21033800_.CSV"
   ' so we want the 8 characters from character 13 converted to a date
   strFile = Dir(initPath & "*.csv")
   If strFile <> "" Then
      Do
         If dteFile < GetDateFromFileName(strFile) Then
            strFinalFile = strFile
         
         End If
         
          strFile = Dir
         
      Loop While strFile <> ""


      If Len(strFinalFile) > 0 Then
        Workbooks.Open initPath & strFinalFile
      End If
      
      
   Else
      MsgBox "No csv files in " & initPath
   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 = Mid$(strFile, 13, 8)
   If Len(strTemp) < 8 Then Exit Function
   strTemp = Right$(strTemp, 2) & "/" & Mid$(strTemp, 5, 2) & "/" & Left$(strTemp, 4)
   If IsDate(strTemp) Then GetDateFromFileName = CDate(strTemp)
End Function

Open in new window

0
 
Rory ArchibaldCommented:
How consistent is that format? Is the number of characters always the same, is the date always the bit between the first and second underscores, or something else?
0
 
Seamus2626Author Commented:
Nailed on Rory, never changes, except the actual date

Cheers
Seamus
0
Cloud Class® Course: Amazon Web Services - Basic

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

 
Eric ZwiekhorstSAP Business ConsultantCommented:
Dear Seamus,

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)


should change into

strTemp = Mid$(strFile, 12,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)

This would change the the place where to look for the date in the file name
0
 
Seamus2626Author Commented:
Thanks Rory!
0
 
Seamus2626Author Commented:
Sorry Zwiekhorst, just seen your post.

Thank you too! Thats worked as well, sorry i couldnt split points, didnt see it

Cheers,
Seamus
0
 
Rory ArchibaldCommented:
It required more changes than that! ;)
0
 
Eric ZwiekhorstSAP Business ConsultantCommented:
No problem seamus,

We are not here to compete, just to help..
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.