Get filenames FSO with rename of file names to get specific name structure using VBScript

I need to rename the following files by removing all the numeric digits that have been associated after the first zero of the file name.

The only part of the file name that I know, the fixed part is this:

StT_QX10
StT_QY20
StT_QE50
StT_QG70
StT_QH90

However, the variable part of the file name that is automatically assigned by the server that generates these text files is unknown for each day, the always different and variable part is this

_46_9448513023277552554
_31_7886000158142287461
_55_2426936282534604666
_39_8749067416635922512
_27_2363684982157969174

Input

StT_QX10_46_9448513023277552554.txt
StT_QY20_31_7886000158142287461.txt
StT_QE50_55_2426936282534604666.txt
StT_QG70_39_8749067416635922512.txt
StT_QH90_27_2363684982157969174.txt

I mean the output I need is as below

Output

StT_QX10.txt
StT_QY20.txt
StT_QE50.txt
StT_QG70.txt
StT_QH90.txt

The numeric digits associated after the first zero digit of the file name are absolutely random and there is no way to know them in advance. But their number is always fixed, that is, first 2 digits preceded and followed by an underscore and then 19 digits without interruption

_46_9448513023277552554.txt
_31_7886000158142287461.txt
_55_2426936282534604666.txt
_39_8749067416635922512.txt
_27_2363684982157969174.txt

I'm stuck here

   Set FSO = CreateObject("Scripting.FileSystemObject")
   
   Arr = Array("StT_QX10", "StT_QY20", "StT_QE50", "StT_QG70", "StT_QH90")
                       
   For I = 0 To UBound(Arr)
      If FSO.FileExists("C:\BOE\StT_" & Arr(I) & "") Then    
   
   Else
      MsgBox("The file does not exist : " & vbcrlf & Now() & vbcrlf & Err.Number & vbcrlf & Err.Description)
   
   End If    
   Next

   Set FSO = Nothing

Solution

If all files are like the provided examples, then all that's needed is to trim the last 23 characters from the base file name. If the last part of the file names vary in length, then another simple approach is to split on the underscore character and keep the first two parts. Here are examples of each approach:

Example 1: Trim the last 23 characters

folderPath = "C:\temp"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set folder = oFSO.GetFolder(folderPath)

For Each file In folder.Files
  If LCase(oFSO.GetExtensionName(file.Name)) = "txt" And Left(file.Name, 4) = "StT_" And Len(file.Name) > 27 Then
    BaseName = oFSO.GetBaseName(file.Name)
    file.Name = Left(BaseName, Len(BaseName) - 23) & ".txt"
  End If
Next

Example 2: Split on underscore and keep the first two parts

folderPath = "C:\temp"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set folder = oFSO.GetFolder(folderPath)

For Each file In folder.Files
  If LCase(oFSO.GetExtensionName(file.Name)) = "txt" And Left(file.Name, 4) = "StT_" And Len(file.Name) > 27 Then
    BaseName = oFSO.GetBaseName(file.Name)
    a = Split(BaseName,"_")
    file.Name = a(0) & "_" & a(1) & ".txt"
  End If
Next