Solved

Adding to code

Posted on 2011-03-10
8
275 Views
Last Modified: 2012-06-21
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

0
Comment
Question by:Seamus2626
  • 3
  • 3
  • 2
8 Comments
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35093258
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
 

Author Comment

by:Seamus2626
ID: 35093270
Nailed on Rory, never changes, except the actual date

Cheers
Seamus
0
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 500 total points
ID: 35093286
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
 
LVL 6

Expert Comment

by:Eric Zwiekhorst
ID: 35093298
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
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Closing Comment

by:Seamus2626
ID: 35093312
Thanks Rory!
0
 

Author Comment

by:Seamus2626
ID: 35093322
Sorry Zwiekhorst, just seen your post.

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

Cheers,
Seamus
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35093332
It required more changes than that! ;)
0
 
LVL 6

Expert Comment

by:Eric Zwiekhorst
ID: 35093389
No problem seamus,

We are not here to compete, just to help..
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

743 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

10 Experts available now in Live!

Get 1:1 Help Now