On Error Resume Next
For Each objWSh In objWB.Worksheets
    Set objNonEmptyCells = objWSh.Cells.SpecialCells(2)
    If Err.Number = 0 Then
        For Each objItem In objNonEmptyCells
            strTemp = objItem.Value
            For i = 0 To UBound(arrIDs)
                If InStr(strTemp, arrIDs(i)) > 0 Then
                    objItem.Value = Replace(strTemp, arrIDs(i), arrNames(i))
                    Exit For
                End If
            Next
        Next
        Set objNonEmptyCells = Nothing
    Else
        Err.Clear
    End If
Next
On Error GoTo 0
Erase arrIDs: Erase arrNames
objWB.Save
objWB.Close
Set objWB = Nothing
objExcel.Quit
WScript.Echo "Готово."

Dim objFS, objFile, strFile
Dim objExcel, objWB, strBook
Dim objNonEmptyCells, objItem
Dim arrTemp, arrIDs(), arrNames()
Dim strTemp, lngTemp, i, j

strFile = "C:\Temp\id.txt"
strBook = "C:\Temp\book.xls"
Set objFS = CreateObject("Scripting.FileSystemObject")
If objFS.FileExists(strFile) Then
    If objFS.GetFile(strFile).Size > 0 Then
        Set objFile = objFS.OpenTextFile(strFile, 1)
        strTemp = objFile.ReadAll
        objFile.Close
        Set objFile = Nothing
        arrTemp = Split(strTemp, vbNewLine)
        lngTemp = UBound(arrTemp)
        j = -1
        For i = 0 To lngTemp
            If Len(arrTemp(i)) > 0 Then
                j = j + 1
                ReDim Preserve arrIDs(j): ReDim Preserve arrNames(j)
                strTemp = Split(arrTemp(i), vbTab)
                arrIDs(j) = strTemp(1)
                arrNames(j) = strTemp(0)
            End If
        Next
        Erase arrTemp
        If objFS.FileExists(strBook) Then
            Set objExcel = CreateObject("Excel.Application")
            Set objWB = objExcel.Workbooks.Open(strBook)
            On Error Resume Next
            Set objNonEmptyCells = objWB.Worksheets(1).Cells.SpecialCells(2)
            If Err.Number = 0 Then
                On Error GoTo 0
                For Each objItem In objNonEmptyCells
                    strTemp = objItem.Value
                    For i = 0 To UBound(arrIDs)
                        If InStr(strTemp, arrIDs(i)) > 0 Then
                            objItem.Value = Replace(strTemp, arrIDs(i), arrNames(i))
                            Exit For
                        End If
                    Next
                Next
                Set objNonEmptyCells = Nothing
                Erase arrIDs: Erase arrNames
                objWB.Save
                WScript.Echo "Готово."
            Else
                Err.Clear
                objWB.Saved = True
                WScript.Echo "Рабочий лист не содержит строковых констант."
            End If
            objWB.Close
            Set objWB = Nothing
            objExcel.Quit
            Set objExcel = Nothing
        Else
            WScript.Echo "Путь " & UCase(strBook) & " не найден."
        End If
    Else
        WScript.Echo "Файл " & UCase(strFile) & " пуст."
    End If
Else
    WScript.Echo "Путь " & UCase(strFile) & " не найден."
End If
Set objFS = Nothing
WScript.Quit 0

Dim objFS, objFile, strFile
Dim objExcel, objWB, strBook
Dim objNonEmptyCells, objItem
Dim arrTemp, arrIDs(), arrNames()
Dim strTemp, lngTemp, i, j

Set objExcel = CreateObject("Excel.Application")
With objExcel.FileDialog(1)
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Простой текст", "*.txt"
    .Show
    If .SelectedItems.Count = 1 Then
        strFile = .SelectedItems(1)
    End If
End With
If Len(strFile) > 0 Then
    Set objFS = CreateObject("Scripting.FileSystemObject")
    If objFS.GetFile(strFile).Size > 0 Then
        Set objFile = objFS.OpenTextFile(strFile, 1)
        strTemp = objFile.ReadAll
        objFile.Close
        Set objFile = Nothing
        arrTemp = Split(strTemp, vbNewLine)
        lngTemp = UBound(arrTemp)
        j = -1
        For i = 0 To lngTemp
            If Len(arrTemp(i)) > 0 Then
                j = j + 1
                ReDim Preserve arrIDs(j): ReDim Preserve arrNames(j)
                strTemp = Split(arrTemp(i), vbTab)
                arrIDs(j) = strTemp(1)
                arrNames(j) = strTemp(0)
            End If
        Next
        Erase arrTemp
        With objExcel.FileDialog(1)
            .AllowMultiSelect = False
            .Filters.Clear
            .Filters.Add "Рабочая книга Excel", "*.xls"
            .Show
            If .SelectedItems.Count = 1 Then
                strBook = .SelectedItems(1)
            End If
        End With
        objExcel.Visible = False
        If Len(strBook) > 0 Then
            Set objWB = objExcel.Workbooks.Open(strBook)
            On Error Resume Next
            Set objNonEmptyCells = objWB.Worksheets(1).Cells.SpecialCells(2)
            If Err.Number = 0 Then
                On Error GoTo 0
                For Each objItem In objNonEmptyCells
                    strTemp = objItem.Value
                    For i = 0 To UBound(arrIDs)
                        If InStr(strTemp, arrIDs(i)) > 0 Then
                            objItem.Value = Replace(strTemp, arrIDs(i), arrNames(i))
                            Exit For
                        End If
                    Next
                Next
                Set objNonEmptyCells = Nothing
                Erase arrIDs: Erase arrNames
                objWB.Save
                WScript.Echo "Готово."
            Else
                Err.Clear
                objWB.Saved = True
                WScript.Echo "Рабочий лист не содержит строковых констант."
            End If
            objWB.Close
            Set objWB = Nothing
            objExcel.Quit
        Else
            WScript.Echo "Файл с рабочей книгой не выбран."
        End If
    Else
        WScript.Echo "Файл " & UCase(strFile) & " пуст."
    End If
    Set objFS = Nothing
Else
    WScript.Echo "Файл с таблицей сопоставления не выбран."
End If
Set objExcel = Nothing
WScript.Quit 0

set FSO = CreateObject("Scripting.FileSystemObject")

file="1.txt"
text=FSO.OpenTextFile(file,1).ReadAll()

key="id.txt"
book=FSO.OpenTextFile(key,1).ReadAll()
book=Split(book,vbCrLf)

For each bookLine in book
  ab=Split(bookLine,vbTab)
  text=RePlace(text,ab(1),ab(0))
Next

FSO.OpenTextFile("out_"&file,2,true).Write(text)

Option Compare Text

Sub Example2()
Dim objFS As FileSystemObject, objFile As TextStream, strPath As String
Dim arrTemp, arrIDs() As String, arrNames() As String
Dim strTemp, lngTemp As Long, i As Long, j As Long
Dim objNonEmptyCells As Range, objItem As Range

With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Простой текст", "*.txt"
    .Show
    If .SelectedItems.Count = 1 Then
        strPath = .SelectedItems(1)
    End If
End With
If Len(strPath) > 0 Then
    Set objFS = New FileSystemObject
    If objFS.GetFile(strPath).Size > 0 Then
        Set objFile = objFS.OpenTextFile(strPath, ForReading)
        strTemp = objFile.ReadAll
        objFile.Close
        Set objFile = Nothing
        arrTemp = Split(strTemp, vbNewLine)
        lngTemp = UBound(arrTemp)
        j = -1
        For i = 0 To lngTemp
            If Len(arrTemp(i)) > 0 Then
                j = j + 1
                ReDim Preserve arrIDs(j): ReDim Preserve arrNames(j)
                strTemp = Split(arrTemp(i), vbTab)
                arrIDs(j) = strTemp(1)
                arrNames(j) = strTemp(0)
            End If
        Next
        Erase arrTemp
        On Error Resume Next
        Set objNonEmptyCells = Worksheets(1).Cells.SpecialCells(xlCellTypeConstants)
        If Err.Number = 0 Then
            On Error GoTo 0
            For Each objItem In objNonEmptyCells
                strTemp = objItem.Value
                For i = 0 To UBound(arrIDs)
                    If InStr(strTemp, arrIDs(i)) > 0 Then
                        objItem.Value = Replace(strTemp, arrIDs(i), arrNames(i))
                        Exit For
                    End If
                Next
            Next
            Set objNonEmptyCells = Nothing
            Erase arrIDs: Erase arrNames
            MsgBox "Готово.", vbInformation
        Else
            Err.Clear
            MsgBox "Рабочий лист не содержит строковых констант.", vbCritical
        End If
    Else
        MsgBox "Файл " & UCase(strPath) & " пуст.", vbCritical
    End If
    Set objFS = Nothing
Else
    MsgBox "Файл не выбран.", vbCritical
End If
End Sub

Option Compare Text

Sub Example()
Dim objFS As FileSystemObject, objFile As TextStream, strPath As String
Dim arrTemp, arrIDs() As String, arrNames() As String
Dim strTemp, lngTemp As Long, i As Long, j As Long
Dim objNonEmptyCells As Range, objItem As Range

strPath = "C:\Temp\id.txt"
Set objFS = New FileSystemObject
If objFS.FileExists(strPath) Then
    If objFS.GetFile(strPath).Size > 0 Then
        Set objFile = objFS.OpenTextFile(strPath, ForReading)
        strTemp = objFile.ReadAll
        objFile.Close
        Set objFile = Nothing
        arrTemp = Split(strTemp, vbNewLine)
        lngTemp = UBound(arrTemp)
        j = -1
        For i = 0 To lngTemp
            If Len(arrTemp(i)) > 0 Then
                j = j + 1
                ReDim Preserve arrIDs(j): ReDim Preserve arrNames(j)
                strTemp = Split(arrTemp(i), vbTab)
                arrIDs(j) = strTemp(1)
                arrNames(j) = strTemp(0)
            End If
        Next
        Erase arrTemp
        On Error Resume Next
        Set objNonEmptyCells = Worksheets(1).Cells.SpecialCells(xlCellTypeConstants)
        If Err.Number = 0 Then
            On Error GoTo 0
            For Each objItem In objNonEmptyCells
                strTemp = objItem.Value
                For i = 0 To UBound(arrIDs)
                    If InStr(strTemp, arrIDs(i)) > 0 Then
                        objItem.Value = Replace(strTemp, arrIDs(i), arrNames(i))
                        Exit For
                    End If
                Next
            Next
            Set objNonEmptyCells = Nothing
            Erase arrIDs: Erase arrNames
            MsgBox "Готово.", vbInformation
        Else
            Err.Clear
            MsgBox "Рабочий лист не содержит строковых констант.", vbCritical
        End If
    Else
        MsgBox "Файл " & UCase(strPath) & " пуст.", vbCritical
    End If
Else
    MsgBox "Путь " & UCase(strPath) & " не найден.", vbCritical
End If
Set objFS = Nothing
End Sub