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

 

[Coding4Fun]

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

 

[Giordano Bruno]

Hi JT,

It would help to know how Range("LISTTERRITORYNAME") is defined and what is in that range also the same for Range("TBTPREFIX")

 

[Fluff]

Could you supply the code for UpdateTasks

 

[Johnny Thunder]

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")

 

[Johnny Thunder]

Could you supply the code for UpdateTasks

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

 

[Fluff]

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

 

[Johnny Thunder]

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"

 

[Fluff]

Put a msgbox in like this

MsgBox Fname
Set vWKBK = Workbooks.Open(Fname, False)

What does the messgae say?

 

[Johnny Thunder]

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

MsgBox Fname
Set vWKBK = Workbooks.Open(Fname, False)

What does the messgae say?