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

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
693
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
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
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
 
Last edited:
Upvote 0
Hi JT,

It would help to know how Range("LISTTERRITORYNAME") is defined and what is in that range also the same for Range("TBTPREFIX")
 
Upvote 0
Could you supply the code for UpdateTasks
 
Upvote 0
Range("LISTTERRITORYNAME") = 10 rows of Country Names and Range("TBTPREFIX") = "Quarter 1" text.

Hi JT,

It would help to know how Range("LISTTERRITORYNAME") is defined and what is in that range also the same for Range("TBTPREFIX")
 
Upvote 0
Could you supply the code for UpdateTasks


Code:
Private Sub UpdateTasks(vFILENAME, vFILEWKBK)
    If Len(Dir(vFILENAME)) <= 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
    
    Workbooks.Open Filename:=vFILENAME, UpdateLinks:=False
    Set vWKBK = Workbooks(vFILEWKBK)
    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
 
Upvote 0
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
 
Upvote 0
Thank you for helping me on this project. I made the changes you sent and I am getting an error when I run the code that the file doesn't exist. I think this is due to the removal of the extension ".xls"
 
Upvote 0
Put a msgbox in like this
Code:
MsgBox Fname
Set vWKBK = Workbooks.Open(Fname, False)
What does the messgae say?
 
Upvote 0
the message you listed is in the UpdateTask module, the RunUpdate module runs before that one and has an error handler so I am getting a 1004 Error: Filename can not be found - And it shows the name of the file with the ".xls" extension.

Put a msgbox in like this
Code:
MsgBox Fname
Set vWKBK = Workbooks.Open(Fname, False)
What does the messgae say?
 
Upvote 0

Forum statistics

Threads
1,213,530
Messages
6,114,163
Members
448,554
Latest member
Gleisner2

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
Back
Top