Верхний регистр наименования файлов и кодировка создаваемого txt файла

Option Explicit
'================= Изменяемые параметры ===============================
Const Num = 5 ' число файлов на перенос в папки №
'======================================================================
Dim oFSO, oDir, Path, oItems, oFiles, Count, i, c, F, Name, A, Mask
Dim T: T = Timer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oDir = CreateObject("Shell.Application")._
NameSpace(oFSO.GetParentFolderName(WSH.ScriptFullName))
If oDir Is Nothing Then WSH.Quit
Path = oDir.Self.Path
Set oItems = oDir.Items
Set oFiles = oDir.Items
oItems.Filter 73920, "*_*_*_*_фас*.jpg"
Count = oItems.Count: i = Count/Num
If i > Fix(i) Then i = Fix(i) + 1
For c = 1 To Fix(i) : oDir.NewFolder c : Next
i = 0 : c = 1
For Each F In oItems
   Name = oFSO.GetFileName(F.Path)
   A = Split(oFSO.GetBaseName(Name), "_")
   With oFSO.CreateTextFile(Path & "\" & c & "\" & Name & ".txt", 1, 1)
      .Write "Fam," & A(0) & vbCrLf & "Im," & A(1) &_
      vbCrLf & "Otch," & A(2) :.Close
   End With
   i = i + 1 : Mask = Mask & ";" & Name
   If i Mod Num = 0 Or i = Count Then
      oFiles.Filter 73920, Mid(Mask, 2) : Mask = Empty
      oDir.ParseName(c).GetFolder.MoveHere oFiles, 5652
      c = c + 1
   End If
Next
MsgBox " Скрипт выполнен за " & Timer - T & " сек.", 4160, " Подготовка файлов для экспорта      "