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

[Johnny Thunder]

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.

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]

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.

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

 

[Fluff]

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]

Thanks for the suggestion. I will give that a try

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]

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.

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

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)

vFILEWKBK = Range("TBTPREFIX").Value & " - " & vCELL.Value

 

[Fluff]

Does Fname include the full file path?
If not try

Set vWKBK = Workbooks.Open(vFILEPATH & Fname, False)

 

[Johnny Thunder]

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

Set vWKBK = Workbooks.Open(vFILEPATH & Fname, False)

 

[Fluff]

Glad to help & thanks for the feedback