[pctechdr]

Βάλε αυτό σε μια λειτουργική μονάδα και δες αν σου κανει

Function FindNumbers()
Dim Db As DAO.Database
Dim rs As DAO.Recordset
Dim pattern As String
Dim item As String
Dim matches As Object
Dim match As Object
Dim number As String
Dim index As Integer
Dim querySQL As String
Dim m As Object ' Declare loop variable

Set Db = CurrentDb
Set rs = Db.OpenRecordset("Data_Result")

pattern = "\d{4}" ' Regular expression pattern to match 4-digit numbers

' Check if the temporary table exists, if not create it
If Not DoesTableExist("TempSearchResults") Then
Db.Execute "CREATE TABLE TempSearchResults (TextBefore TEXT, NumberValue TEXT, TextAfter TEXT)"
End If

' Clear existing records from the temporary table
Db.Execute "DELETE FROM TempSearchResults"

rs.MoveFirst
Do Until rs.EOF
item = rs("Data")

Set matches = CreateObject("VBScript.RegExp")
matches.Global = True
matches.IgnoreCase = True
matches.pattern = pattern

Set match = matches.Execute(item)
If match.Count > 0 Then
For Each m In match
number = m.Value
index = InStr(item, number)
' Insert the result into the temporary table
Db.Execute "INSERT INTO TempSearchResults (TextBefore, NumberValue, TextAfter) VALUES ('" & Left(item, index - 1) & "', '" & number & "', '" & Mid(item, index + Len(number)) & "')"
Next m
End If

rs.MoveNext
Loop

rs.Close
Set rs = Nothing

' Create a query SQL to select from the temporary table
querySQL = "SELECT * FROM TempSearchResults"

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

' Release resources
Set Db = Nothing
Set rs = Nothing
End Function
Function DoesTableExist(strTblName As String) As Boolean
On Error Resume Next
Dim Db As DAO.Database
Set Db = CurrentDb()
Dim Tbl As DAO.TableDef
Set Tbl = Db.TableDefs(strTblName)
If Err.number = 3265 Then
DoesTableExist = False
Exit Function
End If
DoesTableExist = True
End Function