Private Function getAddressNode(ByVal xmlDoc As Object, ByVal curRow As Long, ByVal dataArr As Variant) As Object
Dim pNode As Object, pChildNode As Object
  Set pNode = xmlDoc.createElement("Address")
  Set pChildNode = xmlDoc.createElement("AddressDetails")
    pNode.appendChild pChildNode
    pChildNode.appendChild(xmlDoc.createElement("AddressID")).Text = dataArr(curRow, DataLocationIds.AddressID)
    pChildNode.appendChild(xmlDoc.createElement("TerritoryFeature")).Text = dataArr(curRow, DataLocationIds.TerritoryFeature)
    pChildNode.appendChild(xmlDoc.createElement("idCodeOksm")).Text = dataArr(curRow, DataLocationIds.idCodeOksm)
    pChildNode.appendChild(xmlDoc.createElement("IdAddrType")).Text = dataArr(curRow, DataLocationIds.IdAddrType)
    pChildNode.appendChild(xmlDoc.createElement("UniqueAddress")).Text = dataArr(curRow, DataLocationIds.UniqueAddress)
    pChildNode.appendChild(xmlDoc.createElement("UniqueAddressText")).Text = dataArr(curRow, DataLocationIds.UniqueAddressText)
    pChildNode.appendChild(xmlDoc.createElement("alienCity")).Text = dataArr(curRow, DataLocationIds.alienCity)
    pChildNode.appendChild(xmlDoc.createElement("alienDistrict")).Text = dataArr(curRow, DataLocationIds.alienDistrict)
    pChildNode.appendChild(xmlDoc.createElement("alienLocality")).Text = dataArr(curRow, DataLocationIds.alienLocality)
    pChildNode.appendChild(xmlDoc.createElement("alienStreet")).Text = dataArr(curRow, DataLocationIds.alienStreet)
    pChildNode.appendChild(xmlDoc.createElement("alienHouse")).Text = dataArr(curRow, DataLocationIds.alienHouse)
  Set getAddressNode = pNode
End Function

C:\Users\Valera\Desktop\БД\Поиск\Пробник.xlsm

'Процедура проверки
Sub test()
  Dim val As String
  Dim sFileName As String
  
  sFileName = "d:\strij\1 (1).txt"  'Укажите имя своего файла
  val = DetectCyrillicEncoding(sFileName)
  Call outData(sFileName, val)

End Sub


'Процедура вывода данных из файла на лист
Sub outData(fn As String, cоdePage As String)
  Dim text$, i, n, L, Ar   'inpF$,
    inpF = ActiveWorkbook.Path & "\1.txt"
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Charset = cоdePage
        .Open
        .LoadFromFile fn
        text = .ReadText
        .Close
    End With
    Ar = Split(text, Chr(10))
    Range("A2").Resize(UBound(Ar), 1) = WorksheetFunction.Transpose(Ar)
End Sub

'Функция определения кодировки файла
Function DetectCyrillicEncoding(filePath As String) As String
    Dim bytes() As Byte
    Dim fileNumber As Integer
    Dim i As Long
    Dim utf8Score As Integer, win1251Score As Integer
    
    fileNumber = FreeFile
    Open filePath For Binary Access Read As #fileNumber
    ReDim bytes(LOF(fileNumber) - 1)
    Get #fileNumber, , bytes
    Close #fileNumber
    
    ' Проверка BOM
    If UBound(bytes) >= 2 Then
        If bytes(0) = &HEF And bytes(1) = &HBB And bytes(2) = &HBF Then
            DetectCyrillicEncoding = "UTF-8"
            Exit Function
        End If
    End If
    
    ' Анализ для кириллицы
    For i = 0 To UBound(bytes) - 1
        If bytes(i) = &HD0 Then
            If bytes(i + 1) >= &H90 And bytes(i + 1) <= &HBF Then
                utf8Score = utf8Score + 1
            End If
        ElseIf bytes(i) = &HD1 Then
            If bytes(i + 1) >= &H80 And bytes(i + 1) <= &H8F Then
                utf8Score = utf8Score + 1
            End If
        ElseIf bytes(i) >= &HC0 And bytes(i) <= &HFF Then
            win1251Score = win1251Score + 1
        End If
    Next i
    
    If utf8Score > win1251Score Then
        DetectCyrillicEncoding = "UTF-8"
    ElseIf win1251Score > utf8Score Then
        DetectCyrillicEncoding = "Windows-1251"
    Else
        DetectCyrillicEncoding = "Не удалось определить (возможно ANSI)"
    End If
End Function