Вводится строка, в ней нужно удалить все символы кроме цифр

Sub main()
Dim S$, I%, J%
S = InputBox("")
For I = 1 To Len(S)
  Select Case Mid$(S, I, 1)
  Case "0" To "9": J = J + 1: Mid$(S, J, 1) = Mid$(S, I, 1)
  End Select
Next I
S = Left$(S, J)
MsgBox S
End Sub

Public Function ExtractNumber1(s As String) As Double
    Dim i As Integer, str As String
    For i = 1 To Len(s)
        If InStr(1, "1234567890,", Mid(s, i, 1)) <> 0 Then str = str & Mid(s, i, 1)
    Next
    ExtractNumber1 = CDbl(str)
End Function

Sub main() 'процедура
Dim S$, I%, J%'S:строка, I,J - целые
S = InputBox("")'Вводим строку
For I = 1 To Len(S)'перебираем ее посимвольно
  Select Case Mid$(S, I, 1)'если символ - 
  Case "0" To "9": J = J + 1: Mid$(S, J, 1) = Mid$(S, I, 1)' - цифра, записываем её в позицию J, увиличив J на 1-цу перед этим
  End Select
Next I
S = Left$(S, J)'Обрезаем строку по последней цыфре
MsgBox S'выдаем
End Sub'КОНЕЦ

  Select Case Mid$(S, I, 1)'если символ - 
  Case "0" To "9": J = J + 1: Mid$(S, J, 1) = Mid$(S, I, 1)' - цифра, записываем её в позицию J, увиличив J на 1-цу перед этим
  End Select

if isnumeric(Mid$(S, I, 1))then j=j+1:Mid$(S, J, 1) = Mid$(S, I, 1)

Mid$(S, J, 1) = Mid$(S, I, 1)

Sub bb()
With CreateObject("vbscript.regexp")
    .Pattern = "\D"
    .Global = True
    MsgBox .Replace(InputBox("Введите строку", , "https://www.cyberforum.ru/vba/thread409551.html"), "")
End With
End Sub

 .Pattern = "[^1234567890АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдеёжзийклмнопрстуфхцчшщъыьэюяABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz]"