Добавление разделителя в поле memo в Access

Question

Я пытаюсь разграничить поле memo. В поле есть внутри него несколько заметок, которые мне нужно проанализировать в разных столбцах. Каждая нота, однако, следует той же логике, начинается с mm/dd/yyyy, затем сама заметка следует пробелом.

Так пример одного поля памятки будет

01/25/2000 работал на Rack-ID 03/03/2010 контракт Rack-ID 05/15/2014 обновленный Rack-ID

I нужно, чтобы каждая заметка разбиралась в другой столбец в Access.

Я работал над функцией Split в VBA, они изначально имели «|» как разделитель, но удалил его, теперь мне нужно взять даты

Примечание: «tbl_example» - это таблица в базе данных тестового доступа «Tx_example» - это имя столбца, в котором хранятся данные, которые будут ограничены в моем тесте база данных доступа

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 

Не знаю, как заменить "|" с поиском даты. Также я не против замены и вставки «|» прямо перед каждой датой, поэтому я бы получил свой разделитель.

Проблема: я не уверен, как найти дату в текстовом поле memo, иначе я мог бы использовать функцию replace или запрос на обновление.

Любая помощь приветствуется, спасибо.

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

Я написал что-то подобное недавно, чтобы вытащить нотные заметки из поля памятки. Этот код может работать не так, как есть, но поможет вам ближе и даст вам некоторые идеи.

Некоторые начальные примечания: Не ожидайте, что рутина выполнит полную работу при первой развертке. Создайте таблицу temp для записи ваших результатов, и каждый раз, когда вы запускаете процедуру, сначала очищайте таблицу temp. После каждого запуска настройте свой код, чтобы поймать все, что он пропустил в предыдущем прогоне. Таким образом, вы уточните процедуру, пока не будете точно фиксировать все свои данные. Вы можете также передать отредактировать некоторые заметки, чтобы заставить их работать

+----------+------------+ 
| Field | DataType | 
+----------+------------+ 
| NoteId | AutoNumber | 
| ParentId | Long  | 
| NoteDate | Date/Time | 
| NoteNext | Memo  | 
+----------+------------+ 

Кроме того, я настоятельно рекомендую не использовать несколько полей примечаний в той же таблице. Таблица ваших заметок должна выглядеть как моя таблица temp_Notes выше. После того, как ваша процедура будет успешной, это простой вопрос для работы с вашей таблицей Notes, а не с 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