Adding a Delimiter to a memo field in Access - vba

Question

I am trying to delimit a memo field. The field has within it multiple notes that I need to parse out into different columns. Each note however follows the same logic, starts with mm/dd/yyyy then the note itself followed by a space.
So an example for one memo field would be
01/25/2000 worked on Rack-ID 03/03/2010 contracted Rack-ID 05/15/2014 updated Rack-ID
I need each note parsed out into a different column in Access.
I was working on the Split function in VBA, they had originally had "|" as a delimiter but removed it, now I have to pull on the dates
Note "tbl_example" is the table in my test access database
"Tx_example" is the name of the column holding the data to be delimited in my test access database
Sub Example()
On Error GoTo err_Handler
Dim rsD As DAO.Recordset
Set rsD = CurrentDb.OpenRecordset("tbl_Example")
Do While Not rsD.EOF
rsD.Edit
rsD!F1 = Trim(Split(rsD!Tx_Example, "|")(0))
rsD!F2 = Trim(Split(rsD!Tx_Example, "|")(1))
rsD!F3 = Trim(Split(rsD!Tx_Example, "|")(2))
rsD.Update
rsD.MoveNext
Loop
sub_Exit:
rsD.Close
Set rsD = Nothing
Exit Sub
err_Handler:
If Err.Number = 9 Then
Resume Next
Else
MsgBox "Err: " & Err.Number & vbNewLine & Err.Description
End If
End Sub
Not certain how I replace the "|" with a date search.
Also I'm not against doing a replace and inserting "|" right before each date so I would have my delimiter back.
Problem is I'm not sure how to find the date in a text memo field, otherwise I would be able to use the replace function, or an update query.
Any help is appreciated, thanks.

Answer 1

Public Function AddPipesBeforeDates(ByVal strText As String) As String
Dim regex As RegExp
Dim matches As Object
Set regex = CreateObject("VBScript.RegExp")
regex.Global = True
regex.Pattern = "\d{2}/\d{2}/\d{4}"
Set matches = regex.Execute(strText)
For Each m In matches
strText = Replace(strText, m, "|" & m)
Next
AddPipesBeforeDates = strText
Set matches = Nothing
Set regex = Nothing
End Function
Sub Example()
On Error GoTo err_Handler
Dim rsD As DAO.Recordset
Dim results as variant
Set rsD = CurrentDb.OpenRecordset("tbl_Example")
Do While Not rsD.EOF
results = split(AddPipesBeforeDates(rsD!Tx_Example), "|")
rsD.Edit
rsD!F1 = Trim(results(1))
rsD!F2 = Trim(results(2))
rsD!F3 = Trim(results(3))
rsD.Update
rsD.MoveNext
Loop
sub_Exit:
rsD.Close
Set rsD = Nothing
Exit Sub
err_Handler:
If Err.Number = 9 Then
Resume Next
Else
MsgBox "Err: " & Err.Number & vbNewLine & Err.Description
End If
End Sub

Answer 2

I wrote something like this recently to pull dated notes out of a memo field. This code may not work exactly as is, but will get you closer and give you some ideas.
Some initial notes: Don't expect the routine to do the full job on the first sweep. Create a temp table to write your results to, and each time you run the routine, clear the temp table first. After each run, tweak your code to catch everything it missed in the previous run. This way, you will refine the routine until you capture all your data accurately. You may also have to hand edit some notes to get them to work
+----------+------------+
| Field | DataType |
+----------+------------+
| NoteId | AutoNumber |
| ParentId | Long |
| NoteDate | Date/Time |
| NoteNext | Memo |
+----------+------------+
Also, I highly recommend not using multiple note fields in the same table. Your Notes table should look like my temp_Notes table above. After your routine is successful, its a simple matter of running against your Notes table rather than temp_Notes.
Public Sub MigrateNotes()
Dim db As DAO.Database
Dim rsDest As DAO.Recordset
Dim rsSource As DAO.Recordset
Dim nId As Long
Dim aNotes() As String
Dim n As Long
Dim dtDate As Date
Dim sNote As String
On Error GoTo EH
DoCmd.Hourglass True
Set db = CurrentDb
db.Execute "DELETE * FROM temp_Notes"
Set rsDest = db.OpenRecordset("SELECT * FROM temp_Notes")
Set rsSource = db.OpenRecordset("SELECT RowId,Diary FROM SourceNotes")
With rsSource
Do Until .EOF
nId = .Fields("RowId").Value
aNotes = parseNotes(.Fields("Diary").Value)
For n = 0 To UBound(aNotes)
dtDate = CDate(Left(aNotes(n), 10))
sNote = Right(aNotes(n), Len(aNotes(n)) - 11)
With rsDest
.AddNew
.Fields("RowId").Value = nId
.Fields("NoteDate").Value = dtDate
.Fields("NoteText").Value = sNote
.Update
End With
Next 'n
.MoveNext
Loop
End With
MsgBox "Complete"
GoTo FINISH
EH:
With Err
MsgBox .Number & vbCrLf & .Source & vbCrLf & .Description
.Clear
End With
'for debugging purposes
Debug.Assert 0
GoTo FINISH
Resume
FINISH:
DoCmd.Hourglass False
On Error Resume Next
'release resources
If Not rsDest Is Nothing Then
rsDest.Close
Set rsDest = Nothing
End If
If Not rsSource Is Nothing Then
rsSource.Close
Set rsSource = Nothing
End If
End Sub
Private Function parseNotes(ByVal sRaw As String) As String()
Dim nYear As Long
Dim sYearToken As String
Dim nIndex As Long
Dim nSkip As Long
For nYear = 1999 To Year(Date)
sYearToken = "/" & nYear & " "
'use 12 to skip past first date ("mm/dd/yyyy " = 11)
nSkip = 12
Do
'find the end of the date
nIndex = InStr(nSkip, sRaw, sYearToken)
If nIndex > 0 Then
'find the start of the date
nIndex = nIndex - 6
sRaw = Left(sRaw, nIndex) & vbCrLf & Right(sRaw, Len(sRaw) - nIndex)
'use 12 to skip past next date
nSkip = nIndex + 12
End If
Loop Until nIndex <= 0
Next 'n
parseNotes = Split(sRaw, vbCrLf)
End Function