Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

More adjusting!

Posted on 2011-02-28
18
Medium Priority
?
313 Views
Last Modified: 2012-05-11
I have attached some VBA code that Rory kindly provided me, i have adjusted it for different reports and folders. This particular piece is constantly looping, it cant seem to find the file

My file directory is:G:\Asset Services MI\Sophis Fiscal breaks\2011\2 Feb 2011

The latest file is called

Sophis Fiscal 25022011.xls

Can anyone see from the code why this cant fin the file?

Thanks
Seamus
Sub OpenLatestFileSophisFiscal()
   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\Sophis Fiscal breaks\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("Check").Visible = True
           Sheets("Check").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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
18 Comments
 
LVL 9

Expert Comment

by:McOz
ID: 34997890
Is it possible that your new file is an .xlsx?

In GetDateFromFileName, try replacing:

strTemp = Right$(Replace$(strFile, ".xls", "", , , vbTextCompare), 8)

with:

strTemp = Right$(Split(strFile, ".")(0), 8)

This will handle xlsx extensions as well as plain xls.

Good luck!
0
 
LVL 45

Expert Comment

by:patrickab
ID: 34997913
Change this:

initPath = "\\ukhibmdata02\rights\Asset Services MI\Sophis Fiscal breaks\2011\"

So that it reflects the path to your files - namely:

G:\Asset Services MI\Sophis Fiscal breaks\2011\2 Feb 2011

Perhaps to this:

initPath = "G:\Asset Services MI\Sophis Fiscal breaks\2011\2 Feb 2011"
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 34997933
It works for me in a quick test.
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:Seamus2626
ID: 34998056
Hi McOz, not an xlsx file.

Patrick, thats not the problem either, its still looping away looking for the file.

Rorya, i take it you set up a dummy folder etc

Im gonna try and run my eyes carefully over it again, and if nothing, il post the ss and fodler names.

Thanks
Seamus
0
 

Author Comment

by:Seamus2626
ID: 35005925
Please see the two buttons that are marked red as the problem buttons.

The word doc shows a screenshot of the locations where those files are attempting to open the latest file, it also has shows the format of the excel file names.

I cannot see why the last two buttons wont open the latest files in those folders.

Any help would be much appreciated!

Thanks
Seamus
Example.xls
Doc1.doc
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35006001
I've just tested the Sophis Fiscal one and it works fine for me. Have you tried stepping through the code to see where it is sticking?
0
 

Author Comment

by:Seamus2626
ID: 35006035
it loops through the below code infinately, it doesnt actually error

Seamus
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("Check").Visible = True
           Sheets("Check").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
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35006069
It shouldn't do it indefinitely unless you have an infinite number of files.
Add this:
            Debug.Print "Processing: " & strFile

Open in new window

after the Do line (line 34 in the full code), so you can see in the immediate window which files it is processing.
0
 

Author Comment

by:Seamus2626
ID: 35006198
Tried that a cople of times Rory, in the editor and out of it, its just holding. The hourglass symbol is holding for ages, the only change i made to the files on one of the error buttons was that i made it a shared workbook, would that affect it?
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35006333
Is it outputting any filenames to the immediate window? If not, then it's the folder part that is hanging it. Have you tried it using a drive letter rather than UNC path?
0
 

Author Comment

by:Seamus2626
ID: 35006656
No, nothing appears, i tried the code using the letter and the same result.

Fecking confused, because the pay rec one was working when i first ran that code when you gave it to me originally
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35006663
If you are not seeing any filenames then I think it is caught up trying to find the right folder. When you step through it (using f8) where does it hang?
0
 

Author Comment

by:Seamus2626
ID: 35006686
Thats the thing, it doesnt hang when stepping through, it keeps looping and looping, its not hanfing anywhere when i step through using f8, it goes infinately between lines 34-64 (original posted code) and just keeps looping and looping.....
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35006790
In that case you should be seeing filenames in the Immediate Window due to the code I asked you to add.
0
 
LVL 44

Accepted Solution

by:
AndyAinscow earned 2000 total points
ID: 35006996
        Do
            If dteFile < GetDateFromFileName(strFile) Then
               strFinalFile = strFile
               strFile = Dir
            End If
         Loop While strFile <> ""


IF strFile is not "" then it checks dteFile < GetDateFromFileName(strFile)
If dteFile >= GetDateFromFileName(strFile) then strFile is NOT CHANGED = infinite loop
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35007034
Very good point, Andy. The strFile = Dir line should be after the End If not before.
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35007057
PS Points to Andy, obviously! :)
0
 

Author Closing Comment

by:Seamus2626
ID: 35008568
Sorry, was away from my desk. Perfect Andy, great spot.

Thank you to Rory.

Cheers
Seamus
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

705 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