تحويل النص الى عدة حقول

هذه الدالة تعطيك ما تريد و بدون الحاجة الى جدول ثانى 

يمكنك عرض اى جزء تريده فى استعلام او نموذج 

Function Text2Columns(AnyName As String, NumberOfPart As Byte) As String
Dim TheSpaceNumber As Byte

Dim I As Integer, U As Integer
Clear_Extra_Spaces:
'=================
  If InStr(1, AnyName, "  ", 1) > 0 Then
       AnyName = Replace(AnyName, "  ", " ")
       GoTo Clear_Extra_Spaces
  End If
Text2Columns = ""
If AnyName = "" Then Exit Function

Do
    U = I
    I = InStr(I + 1, AnyName, " ", 1) 'find number of spaces in the name
    If I <> 0 Then
        TheSpaceNumber = TheSpaceNumber + 1
        If TheSpaceNumber = NumberOfPart Then Exit Do
    ElseIf TheSpaceNumber + 1 = NumberOfPart Then
        I = Len(AnyName) + 1
        Exit Do
    Else
        Exit Function
    End If
Loop
    
    Text2Columns = Trim(Mid(AnyName, U + 1, I - U - 1))
End Function

text to columns.accdb

الشكر موصول بالدعاء لكم