Solved

More adjusting!

Posted on 2011-02-28
18
268 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
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
 

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
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
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 500 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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
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 …

759 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

16 Experts available now in Live!

Get 1:1 Help Now