Adapt Script that copies specific files and renames them (VBS)

Well I already have a script that does the reading and copying of the files, however, I need to refine it a bit more, for example:

CURRENTLY:

I get the list of file names:

• AAAAA1.jpg

• AAAAA2.jpg

• AAAAA3.jpg

I need it to be:

For example in my list I receive:

• AAAAA1.jpg, 2018, DOCB, RN

• AAAAA2.jpg, 2016, DOCA, SP

• AAAAA3.jpg, 1998, DOCT, TO

And that my output is formatted for OriginalOriginalDirectoryName_Doc_DataType, example:

• AAAAA1_2018_DOCB_RN.jpg

• AAAAA2_2016_DOCA_SP.jpg

• AAAAA3_1998_DOCT_TO.jpg

  Option Explicit
  
  ' Pasta com os arquivos a serem copiados
  Const strSourceFolder = "H:"
  
  ' Pasta pra onde os arquivos irão
  Const strTargetFolder = "C:\Temp\Target\"
  
  ' Lista com o nome dos arquivos que preciso. APENAS O NOME DO ARQUIVO UM POR LINHA
  Const strFileList = "C:\filelist.txt"
  
  ' Se pode sobreescrever caso já exista? TRUE or FALSE.
  Const blnOverwrite = FALSE
  
  Dim objFSO
  
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  
  Const ForReading = 1
  
  Dim objFileList
  
  Set objFileList = objFSO.OpenTextFile(strFileList, ForReading, False)
  
  Dim strFileToCopy, strSourceFilePath, strTargetFilePath
  
  On Error Resume Next
  
  Do Until objFileList.AtEndOfStream
  
  ' Lê o nome do arquivo e cria os filepath (caminhos)
  
  strFileToCopy = objFileList.Readline
  
  strSourceFilePath = objFSO.BuildPath(strSourceFolder, strFileToCopy)
  
  strTargetFilePath = objFSO.BuildPath(strTargetFolder, strFileToCopy)
  
  ' Copia pro caminho especificado
  Err.Clear
  
  objFSO.CopyFile strSourceFilePath, strTargetFilePath, blnOverwrite
  
  If Err.Number = 0 Then
  
      ' Deu tudo ok 
  
  Else
      ' Deu pau!
  
      Wscript.Echo "Error " & Err.Number & " (" & Err.Description & "). Copying " & strFileToCopy
  
  End If
  
  Loop