Solved

Adding to code

Posted on 2011-03-10
8
277 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

929 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

8 Experts available now in Live!

Get 1:1 Help Now