Solved

Adding to code

Posted on 2011-03-10
8
279 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
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 
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
 

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

U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Excel Formula 5 46
Excel User Form VBA Help 18 32
VBA name newly created sheet 4 24
Return a string either side of a specific character in that string - Excel 6 16
Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

810 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