Private Sub CommandButton1_Click()
    Dim input, out As String
    Dim k, n As Integer
    Dim textArray() As String

    input = ReadFromFile("Текст1.txt")
    n = Len(input)
    ReDim textArray(n - 1)

    For k = 0 To n - 1
        ' textArray(k) = Mid(a, k + 1, 1)
        textArray(k) = input.charAt(k)
        Next k

    If IsDigitsOnly(textArray) Then
        WriteToFile("Text contains only digits")

    Else
        If HasMoreLatins(textArray) Then
            ReplaceLatins(textArray)
        Else
            ReplaceNonLatins(textArray)
        End If

        For k = 0 To Len(input) - 1
            out = out & textArray(k)
        Next k

        Call WriteToFile("Текст2.txt", out)
    End If

End Sub


Private Function IsDigitsOnly(ByRef text() as String) as Boolean
    For k = 0 To Len(text)
        If Not (text(k) Like "[0-9]") Then
            IsDigitsOnly = False
        End If
    Next k

    IsDigitsOnly = True
End Function


Private Function HasMoreLatins(ByRef text() As String) as Boolean
    Dim currentChar as String
    Dim latinCount, nonLatinCount, k as Integer

    latinCount = nonLatinCount = 0;
    For k = 0 To Len(text) - 1
        currentChar = Lcase(text(k))
        If currentChar Like "[a-z]" Then
            latinCount = latinCount + 1

        ElseIf Not (currentChar Like " " Or currentChar Like ".") Then
            nonLatinCount = nonLatinCount + 1

        End If
    Next k
    IsMoreLatins = (latinCount > nonLatinCount)
End Function


Private Sub ReplaceLatins(ByRef text() as String)
    Dim k as Integer

    For k = 0 to Len(text) - 1
        If Lcase(text(k)) Like "[a-z]" Then
            text(k) = "4"
        End If
    Next k
End Sub


Private Sub ReplaceNonLatins(ByRef text() as String)
    Dim k as Integer

    For k = 0 to Len(text) - 1
        If Lcase(text(k)) Like "[!a-z .]" Then
            text(k) = "4"
        End If
    Next k
End Sub


Private Function ReadFromFile(ByRef fileName As String) As String
    Dim fso
    Dim file
    Dim readedString as String

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.OpenTextFile(fileName, 1)
    readedString = file.ReadAll
    file.Close

    ReadFromFile = readedString
End Function


Private Sub WriteToFile(ByRef fileName As String, ByRef s As String)
    Dim fso
    Dim file

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.CreateTextFile(fileName, True, True)

    file.WriteLine(s)
    file.Close
End Sub