'API для кодирования из WIN в DOS
Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long

'API для раскодирования из DOS в WIN
Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Enum CDE
      WinDos = (0)
      DosWin = (1)
End Enum

Sub Transform()

x = "U:\РАССЫЛКА\*.txt"

file = Dir(x)
file = UCase(file)

If file = "" Then MsgBox "Такой папки нет." & Chr(13) & "Проверьте путь к файлу: " & x, vbCritical, "Ошибка": Exit Sub

                   Do While file <> ""
        
          Name = "U:\РАССЫЛКА\" & file
          Путь = "U:\РАССЫЛКА\АКТ\" & file
          F = FreeFile
          Open Путь For Append As #F
         
          F1 = FreeFile
            
          Open Name For Input As #F1 'считывание данных из файла Name

              Do Until EOF(F1)
              Line Input #F1, MyText   ' промотр содержимого файла
                   
                  For Index = 1 To Len(MyText)
                      C = Mid(MyText, Index, 1)
                      
                      Result = Result + C
                            
                  Next Index
                    
                  Result = Recode(Result, WinDos)
                    
                  Print #F, Result
                  Result = ""
                  
              Loop
          Close #F
          Close #F1
            
            
          file = Dir
          Loop
End Sub

Public Function Recode(ByVal strTextOut As String, rCode As CDE)

Dim strTextInput As String 'Строковая переменная для вывода
Dim lngCode As Long 'Числовая переменная

'Кодировка и раскодировка текста
Select Case rCode
      Case Is = (WinDos) 'Выбераем кодировку
      strTextInput = Space$(Len(strTextOut)) 'Перекодированная строка
      lngCode = CharToOem(strTextOut, strTextInput) 'Присваеваем переменной lngCode
      Recode = strTextInput 'Выводим текст
        
      Case Is = (DosWin) 'Выбераем кодировку
      strTextInput = Space$(Len(strTextOut)) 'Перекодированная строка
      lngCode = OemToChar(strTextOut, strTextInput) 'Присваеваем переменной lngCode
      Recode = strTextInput 'Выводим текст
      End Select
End Function