Extracting Numbers from text String and Sum?

This seems to work :

Sub Sum_Values()
    Const STRING_TO_SEARCH = "1991 SARW VIN #MG0910433R in 1982 Homemade Semi Trailer VIN #NEBR007742 ~30k; Trailer VIN #CLA1995W248T4112 ~10k; Trailer VIN #1024395 ~8k; Model #LS-4207, VIN #1C9GB42363G864016 ~15k"
    Dim sum As Long, strDigits As String, pos As Integer
    
    strDigits = ""
    sum = 0
    For pos = 1 To Len(STRING_TO_SEARCH)
        If Mid(STRING_TO_SEARCH, pos, 1) = "~" Then
            pos = pos + 1
            Do While Mid(STRING_TO_SEARCH, pos, 1) >= "0" And Mid(STRING_TO_SEARCH, pos, 1) <= "9"
                strDigits = strDigits & Mid(STRING_TO_SEARCH, pos, 1)
                pos = pos + 1
            Loop
            sum = sum + Val(strDigits)
            strDigits = ""
        End If
    Next pos
    MsgBox sum
    
End Sub