Retrieve 6 numbers from string (1 Viewer)

[bodylojohn]

Hello everybody....

In my application I can read mails from outlook.
I search for a specific keyword in a string (message) and then I retrieve the line.

Now I would like to search for a number that is always 6 digits long.
So in the line I would like to retrieve numbers from 000000 to 999999.
I found several pieces of code but none suffied.

I really hope you can help me in the right direction.

Thanks in advance.

The code I use to read the mails is:

Sub LoopThroughSQL()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strSQL As String

    ' Open the database
    Set db = CurrentDb

    ' Define your SQL query
    strSQL = "SELECT Onderwerp, Inhoud, Afzender FROM [Postvak IN] WHERE Afzender = 'E-mailgoedkeuring' AND Onderwerp LIKE '*keur de atv-formulier investeringen goed*';"

    ' Open a recordset based on the SQL query
    Set rs = db.OpenRecordset(strSQL)

    ' Check if there are records returned by the query
    If Not rs.EOF Then
        rs.MoveFirst ' Move to the first record

        ' Loop through records
        Do Until rs.EOF
            ' Access field values using rs.Fields("FieldName").Value
            myText = rs.Fields("Inhoud").value
            ' Add more fields as needed

            ' Move to the next record
            rs.MoveNext
        Loop
    Else
        Debug.Print "No records found based on the query."
    End If

    ' Close the recordset and database
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

The code I use to find the line I need:

Sub SearchAndStoreLine()
 
    Dim searchText As String
    Dim lines() As String
    Dim line As Variant

    ' Sample text to search within
'    myText = "This is line 1." & vbCrLf & _
'             "This is line 2. It contains the keyword." & vbCrLf & _
'             "This is line 3."

    ' Text to search for
    searchText = "Verantwoordelijke kostenplaats"

    ' Split the text into an array of lines
    lines = Split(myText, vbCrLf)

    ' Loop through each line
    For Each line In lines
        ' Check if the searchText is present in the current line
        If InStr(1, line, searchText, vbTextCompare) > 0 Then
            ' If found, store the entire line
            Debug.Print "Line Found: " & line
            MsgBox ("Line Found: " & line)
            ' You can store the line in another variable or perform other actions
        End If
    Next line
End Sub

So I would need to retrieve the 6 digits from Line.

 

[ebs17]

Sub d6_test()
   
    Dim sExpression As String
    Dim oMC As Object
    Dim i As Long
    sExpression = "This is line 1." & vbCrLf & _
             "This is line 2. It contains the keyword 456344 and other" & vbCrLf & _
             "This is line 3."
    Set oMC = RegExMatchCollection(sExpression & vbCrLf, "^.*(\d{6}).*\n")
    For i = 0 To oMC.Count - 1
        Debug.Print i, oMC(i), oMC(i).SubMatches(0)
    Next
   
End Sub

Private pRegEx As Object

Public Property Get oRegEx(Optional Reset As Boolean) As Object
   If (pRegEx Is Nothing) Then Set pRegEx = CreateObject("Vbscript.Regexp")
   If Reset Then Set pRegEx = Nothing
   Set oRegEx = pRegEx
End Property

Public Function RegExMatchCollection(ByVal SourceText As String, _
      ByVal SearchPattern As String, _
      Optional ByVal bIgnoreCase As Boolean = True, _
      Optional ByVal bGlobal As Boolean = True, _
      Optional ByVal bMultiLine As Boolean = True) As Object
 
   With oRegEx
      .Pattern = SearchPattern
      .IgnoreCase = bIgnoreCase
      .Global = bGlobal
      .MultiLine = bMultiLine
      Set RegExMatchCollection = .Execute(SourceText)
   End With
End Function

The test routine could be converted into a function that returns either the entire line content or just the 6 digits you are looking for and that could be used immediately as part of the query.

 

[arnelgp]

using also regexp if you have 1 or more six digit on the string:

Function GetNum(ByVal MyVar As String) As String

    Dim objregExp As Variant, matches, match, MyNum

    Set objregExp = CreateObject("vbscript.regexp")
    objregExp.pattern = "[0-9]{6}"
    objregExp.Global = True
    objregExp.ignorecase = True
        
    Set matches = objregExp.Execute(MyVar)
    For Each match In matches
        MyNum = MyNum & "," & match
    Next
    If Len(MyNum) Then
        MyNum = Mid$(MyNum, 2)
    End If

    Set matches = Nothing
    Set objregExp = Nothing

    GetNum = MyNum

End Function