Как переставить цифры числа так, чтобы образовалось максимальное и минимальное числа, записанные теми же цифрами - VB

Option Explicit
 
Private Sub Form_Load()
    Dim I As Long, Min As Long, Max As Long
    Calc Val(InputBox("Введите число")), Min, Max
    MsgBox Format$(Min, "Минимальное 0") & vbNewLine & Format$(Max, "Максимальное 0")
End Sub
 
Private Sub Calc(Inp As Long, OutMin As Long, OutMax As Long)
    Dim i1 As Long, i2 As Long, ch As String, o As String
    o = CStr(Inp)
    Do
        If Mid$(o, i1 + 1, 1) > Mid$(o, i2 + 1, 1) Then
            ch = Mid$(o, i1 + 1, 1)
            Mid$(o, i1 + 1, 1) = Mid$(o, i2 + 1, 1)
            Mid$(o, i2 + 1, 1) = ch
        End If
        If i2 = Len(o) - 1 Then i1 = i1 + 1: i2 = i1 + 1 Else i2 = i2 + 1
    Loop While i2 < Len(o)
    OutMin = Val(o): OutMax = Val(StrReverse(o))
End Sub