Интеррресная тема, советую посмотреть

Sub Main()
Dim i As Integer
   
    Set ws = ThisWorkbook.Worksheets("Start")
    AllSymbols = ws.Range("B2").Value
    DigMax = Len(AllSymbols)
    MinLength = ws.Range("B3").Value
    MaxLength = ws.Range("B4").Value
    If MinLength > MaxLength Then Exit Sub
   
    Application.ScreenUpdating = False
    [COLOR=red]Open ThisWorkbook.Path & "\result.txt" For Output As #1[/COLOR]
   
    iRow = MaxRow 'Это для того, чтобы сразу воспользоваться функцией NextCell
    iCol = MaxCol
    Set w = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

    ReDim Letters(0 To MaxLength)  'Для чего "+1" станет ясно ниже
   
    For i = 0 To MaxLength - MinLength 'Начинаем с числа вида 00011111
        Letters(i) = 0
    Next i
    For i = MaxLength - MinLength + 1 To MaxLength
        Letters(i) = 1
    Next i
   
    While Letters(0) = 0 '0-й разряд специально сделан лишним, чтобы следить за "переполнением"
       
        Call NextCell 'Переходим к следующей ячейке
        w.Cells(iRow, iCol).Value = CurrentString() 'Записывем очередное слово
        Application.StatusBar = w.Name & ":" & iCol & ":" & iRow & "=" & w.Cells(iRow, iCol).Value
        [COLOR=red]Print #1, w.Cells(iRow, iCol).Value[/COLOR]
        Call NextArray
       
    Wend
   
    [COLOR=red]Close #1[/COLOR]
    Application.StatusBar = False
    Application.ScreenUpdating = True
   
End Sub