Update to Existing Code to Search for File Extension .xls or .xlsm

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
677
Office Version
  1. 2016
Platform
  1. MacOS
Hi guys,

working on updating a workbook that contains some code that was inserted into a UserForm.

I am having an issue because the code looks in a specific folder with both .xls and .xlsm file and the usual "*.xls*" wildcard doesn't seem to be working?

I have tried both "*xl*" and "*xls*" as updates to the line below in question but I keep getting a Error:9 Subscript out of range error message.

If there was a way to say try .xls first, if it doesn't work then try .xlsm next that would probably fix the issue.

Any help is appreciated.

Code:
Private Sub Run_Update()
On Error GoTo ErrorHandler:


    Application.StatusBar = "TBT Update File is starting..."
    vAPSTATE1 = Application.Calculation
    
    Application.ScreenUpdating = False
    Application.Cursor = xlNormal
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False


    vERRORCOUNT = 0
    Set vUSHT = ThisWorkbook.Sheets("Admin")


    If CheckBoxAdmin1 = True Then
        For Each vCELL In Range("LISTTERRITORYNAME").Cells
            vFILEPATH = ThisWorkbook.Path & "\"
            vFILEWKBK = Range("TBTPREFIX").Value & " - " & vCELL.Value & "*.xls*"  'This is the line that is causing the issue
            vFILENAME = vFILEPATH & vFILEWKBK
        
            UpdateTasks vFILENAME, vFILEWKBK
        Next
    
   
        
        
        MsgBox "Your files have been updated!", vbInformation, "All Done!"
    Else
        vFILEPATH = ThisWorkbook.Path & "\"
        vFILEWKBK = txtFileName
        vFILENAME = vFILEPATH & vFILEWKBK
        
        UpdateTasks vFILENAME, vFILEWKBK
    End If
    
ExitSub:
    Application.DisplayAlerts = True
    Application.Calculation = vAPSTATE1
    Application.Cursor = xlNormal
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Set vWKBK = Nothing
    
    Unload Me
    Exit Sub


ErrorHandler:
    vERRORCOUNT = vERRORCOUNT + 1
    MsgBox "Error: " & Err.Number & " - " & Err.Description & vbNewLine & vbNewLine & _
        "An error has occurred while trying to update your " & vbNewLine & _
        "file. Please contact your file administrator before " & vbNewLine & _
        "continuing.", vbCritical
    
    GoTo ExitSub
End Sub
 

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
677
Office Version
  1. 2016
Platform
  1. MacOS
So I tried your updates and for some reason it is bypassing any file with an ".xslm" extension and even the original error handler is not firing so it just runs all the .xls files and then says its complete.

Could this be because there is already an error handler present before I added your handler?

Just a guess as I was not able to actually replicate what you have to test this.

Code:
Private Sub Run_Update()
On Error GoTo ErrorHandler:

    Application.StatusBar = "TBT Update File is starting..."
    vAPSTATE1 = Application.Calculation
    
    Application.ScreenUpdating = False
    Application.Cursor = xlNormal
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False




    vERRORCOUNT = 0
    Set vUSHT = ThisWorkbook.Sheets("Admin")




    If CheckBoxAdmin1 = True Then
        For Each vCELL In Range("LISTTERRITORYNAME").Cells
            vFILEPATH = ThisWorkbook.Path & "\"
            [COLOR=#ff0000]On Error GoTo FileTypeError:[/COLOR]
            vFILEWKBK = Range("TBTPREFIX").Value & " - " & vCELL.Value & [COLOR=#ff0000]".xls"[/COLOR]  'This is the line that is causing the issue
            vFILENAME = vFILEPATH & vFILEWKBK
        
            UpdateTasks vFILENAME, vFILEWKBK
        Next
[COLOR=#ff0000]On Error GoTo ErrorHandler:[/COLOR]
   
        
        
        MsgBox "Your files have been updated!", vbInformation, "All Done!"
    Else
        vFILEPATH = ThisWorkbook.Path & "\"
        vFILEWKBK = txtFileName
        vFILENAME = vFILEPATH & vFILEWKBK
        
        UpdateTasks vFILENAME, vFILEWKBK
    End If
    
ExitSub:
    Application.DisplayAlerts = True
    Application.Calculation = vAPSTATE1
    Application.Cursor = xlNormal
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Set vWKBK = Nothing
    
    Unload Me
    Exit Sub




ErrorHandler:
    vERRORCOUNT = vERRORCOUNT + 1
    MsgBox "Error: " & Err.Number & " - " & Err.Description & vbNewLine & vbNewLine & _
        "An error has occurred while trying to update your " & vbNewLine & _
        "file. Please contact your file administrator before " & vbNewLine & _
        "continuing.", vbCritical
    
    GoTo ExitSub
    
[COLOR=#ff0000]FileTypeError:
    vFILEWKBK = Range("TBTPREFIX").Value & " - " & vCELL.Value & ".xlsm"
    Resume Next[/COLOR]
    
End Sub
 

Some videos you may like

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,325
Office Version
  1. 365
Platform
  1. Windows
I would suggest removing all error handlers for the time being. As they can cause problems when trying to debug code.
Then step through the code suing F8 & see what happens & where.

Have a look at this article about error handlers.
http://excelmatters.com/2015/03/17/on-error-wtf/
 

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
677
Office Version
  1. 2016
Platform
  1. MacOS
Ok Fluff, I did some cleanup to all the other code in the workbook and removed the error handlers as you suggested and using the code updates you provided I am getting a 1004 Runtime error and the debugger is highlighting this line below. the other weird thing is that in the runtime error message it actually references the file name and says "my file name.correct extension" can not be found? I thought that was kinda weird because the file is in the correct folder location and the name of the file is correct.

Code:
Sub UpdateTasks(vFILENAME, vFILEWKBK)
    
    Dim Fname As String
   Fname = Dir(vFILENAME & ".xls*")
    If Len(Fname) <= 0 Then
        vERRORCOUNT = vERRORCOUNT + 1
        MsgBox "The file """ & vFILEWKBK & """ cannot be found." & vbNewLine & vbNewLine & _
            "Either you have re-named your TBT model or have placed this" & vbNewLine & _
            "update file in the wrong location. For more information" & vbNewLine & _
            "please review the notes worksheet." & vbNewLine & vbNewLine & _
            "If your problem continues, please contact your file administrator.", _
            vbExclamation
        ThisWorkbook.Activate
        Sheets("Notes").Select
        GoTo ExitSub
    End If
    
    Set vWKBK = Workbooks.Open(Fname, False) '<-----------Highlight this line as part of the error



Untested, but try
Code:
Private Sub UpdateTasks(vFILENAME, vFILEWKBK)
   Dim Fname As String
   Fname = Dir(vFILENAME & ".xls*")
    If Len(Fname) <= 0 Then
        vERRORCOUNT = vERRORCOUNT + 1
        MsgBox "The file """ & vFILEWKBK & """ cannot be found." & vbNewLine & vbNewLine & _
            "Either you have re-named your TBT model or have placed this" & vbNewLine & _
            "update file in the wrong location. For more information" & vbNewLine & _
            "please review the notes worksheet." & vbNewLine & vbNewLine & _
            "If your problem continues, please contact your file administrator.", _
            vbExclamation
        ThisWorkbook.Activate
        Sheets("Notes").Select
        GoTo ExitSub
    End If
    
    Set vWKBK = Workbooks.Open(Fname, False)
    vWKBK.Activate
    
    Application.StatusBar = "Updating """ & vFILEWKBK & """ please wait ..."

ExitSub:
    If vERRORCOUNT > 0 Then
        Application.StatusBar = "An error has occured. Unable to save changes. Closing file. Please wait ..."
        If vWKBK Is Nothing Then
        Else
            vWKBK.Close False
        End If


        MsgBox "The udpate file was unable to complete its changes " & vbNewLine & _
               "because " & vERRORCOUNT & " error(s) have occured.", _
               vbCritical, "Update Incomplete"
    Else
        Calculate
        If chkOption2 = True Then
            Application.StatusBar = "Upates are complete. Saving file. Please wait ..."
            vWKBK.Save
        End If
        If chkOption3 = True Then
            Application.StatusBar = "Udpates are complete. Closing file. Please wait ..."
            vWKBK.Close SaveChanges:=True
        End If


        ThisWorkbook.Activate
        Sheets("Title").Select
        
        If CheckBoxAdmin1 = False Then
            MsgBox "Your file has been updated!", vbInformation, "All Done!"
        End If
    End If
End Sub
and remove the extension from this (in the 1st code you posted)
Code:
vFILEWKBK = Range("TBTPREFIX").Value & " - " & vCELL.Value
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,325
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Does Fname include the full file path?
If not try
Code:
Set vWKBK = Workbooks.Open(vFILEPATH & Fname, False)
 

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
677
Office Version
  1. 2016
Platform
  1. MacOS
Woohoo! That was it, updating that line corrected the issues and now it is running!

Thanks again for helping out with this. It was a beast of a project and your help really made it go much faster.

Does Fname include the full file path?
If not try
Code:
Set vWKBK = Workbooks.Open(vFILEPATH & Fname, False)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,325
Office Version
  1. 365
Platform
  1. Windows
Glad to help & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,127,141
Messages
5,622,969
Members
415,943
Latest member
JakeG

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top