Here's a little code that might help. Obviously you will need to adapt it to your circumstances ... After you do this for a while, you begin to recognize the "seams" in text patterns.
Option Compare Database
Option Explicit
Private rst As Recordset ' declared here so we can use it anywhere
Private Torst As Recordset ' declared here so we can use it anywhere
Private theName As String ' the name of the person
Public Sub aaaRunParser()
Dim r As Boolean
r = ParseAddresses
End Sub
'
Private Function ParseAddresses() As Boolean
' Purpose: ParseAddresses - split hairy addresses
On Error GoTo errorexit
Dim result As Boolean
result = False
'================================
Dim db As DAO.Database
Set db = CurrentDb
Set rst = db.OpenRecordset("Table1", dbOpenDynaset)
Set Torst = db.OpenRecordset("Table2", dbOpenDynaset)
Do While Not rst.EOF
'================================
Dim addresses As String
theName = rst!theName
addresses = rst!Field2
SplitThem addresses
' Debug.Print addresses
'================================
continue:
rst.MoveNext
Loop
'================================
rst.Close
Set rst = Nothing
Torst.Close
Set Torst = Nothing
db.Close
Set db = Nothing
result = True
exitprocessing:
ParseAddresses = result
Exit Function
errorexit:
Debug.Print Err, "ParseAddresses", Erl
#If PNRDEV Then
Stop
Resume
#End If
Resume exitprocessing
Resume
End Function
Public Sub SplitThem(addresses As String)
Dim address As String
Do While AnotherAddress(addresses, address)
Parse (address)
Loop
End Sub
Public Function AnotherAddress(addresses As String, address As String) As Boolean
' find the start position
Dim first As Long
first = InStr(1, addresses, "{")
If first = 0 Then ' no more addresses
AnotherAddress = False
address = ""
Exit Function
End If
' find the last position
Dim last As Long
last = InStr(1, addresses, "}") ' position of the }
Dim length As Integer: length = last - 1 - first ' always a little tricky
address = Mid(addresses, first + 1, length)
' Debug.Print address
' eat the address from addresses
addresses = Mid(addresses, last + 1) ' skip over the first }
' Debug.Print addresses
AnotherAddress = True
End Function
Public Sub Parse(address As String)
' let's dump the quotes
address = Replace(address, """", "")
' and the spaces following the commas
address = Replace(address, ", ", ",")
' now let's split the fields
Dim flds() As String ' 0-based
flds = Split(address, ",")
' store them in the appropriate fields in the database
' in the same table, or elsewhere
' some tedium here
Dim nv() As String ' name, value
Torst.AddNew
Torst.Fields("TheName") = theName
nv = Split(flds(0), ":")
Torst.Fields(nv(0)) = nv(1)
nv = Split(flds(1), ":")
Torst.Fields(nv(0)) = nv(1)
nv = Split(flds(2), ":")
Torst.Fields(nv(0)) = nv(1)
nv = Split(flds(3), ":")
Torst.Fields(nv(0)) = nv(1)
Torst.Update
End Sub
peter n roth - http://PNR1.com, Maybe some useful stuff
