’–––––––––––––––––––––––––
’プロシージャの概要:
’処理名:文字列トークン化処理
’概要:ダブルクォートで囲まれた文字列を@txt連番のトークンに置換する
’–––––––––––––––––––––––––
Public Sub prcCreate文字列トークン化()
Const C_TABLE_SOURCE As String = “t02d_トークン化”
Const C_TABLE_OUTPUT As String = “t03a_文字列トークン化”
Const C_TABLE_TOKEN As String = “t04a_文字列トークン管理”
Const C_TOKEN_PREFIX As String = “@txt”
```
Dim dbs As DAO.Database
Dim rstSource As DAO.Recordset
Dim rstOutput As DAO.Recordset
Dim rstToken As DAO.Recordset
Dim strSQL As String
Dim strCode As String
Dim strResult As String
Dim lngTokenCounter As Long
Dim lngCodeLineID As Long
Set dbs = CurrentDb
'出力テーブルのクリア
strSQL = "DELETE FROM " & C_TABLE_OUTPUT
dbs.Execute strSQL
strSQL = "DELETE FROM " & C_TABLE_TOKEN
dbs.Execute strSQL
'レコードセットを開く
strSQL = "SELECT * FROM " & C_TABLE_SOURCE & " ORDER BY CodeLineID"
Set rstSource = dbs.OpenRecordset(strSQL, dbOpenDynaset)
strSQL = "SELECT * FROM " & C_TABLE_OUTPUT
Set rstOutput = dbs.OpenRecordset(strSQL, dbOpenDynaset)
strSQL = "SELECT * FROM " & C_TABLE_TOKEN
Set rstToken = dbs.OpenRecordset(strSQL, dbOpenDynaset)
lngTokenCounter = 1
'全レコードを処理
Do Until rstSource.EOF
lngCodeLineID = rstSource!CodeLineID
strCode = Nz(rstSource!トークン化コード, "")
'文字列トークン化処理を実行
strResult = fncTokenizeString(strCode, lngCodeLineID, rstToken, lngTokenCounter)
'結果を出力テーブルに追加
With rstOutput
.AddNew
!CodeLineID = lngCodeLineID
!文字列トークン化コード = strResult
.Update
End With
rstSource.MoveNext
Loop
'後処理
rstSource.Close
rstOutput.Close
rstToken.Close
Set rstSource = Nothing
Set rstOutput = Nothing
Set rstToken = Nothing
Set dbs = Nothing
MsgBox "文字列トークン化処理が完了しました。" & vbCrLf & _
"処理件数: " & lngTokenCounter - 1 & "個のトークンを作成", vbInformation
```
End Sub
’–––––––––––––––––––––––––
’プロシージャの概要:
’処理名:文字列トークン化実行
’概要:1行のコード内の文字列リテラルをトークンに置換する
’strCode:処理対象のコード
’lngCodeLineID:コード行ID
’rstToken:トークン管理テーブルのレコードセット
’lngTokenCounter:トークン連番（参照渡しでインクリメント）
’[戻り値]:トークン化後のコード
’–––––––––––––––––––––––––
Private Function fncTokenizeString(ByVal strCode As String, _
ByVal lngCodeLineID As Long, _
ByRef rstToken As DAO.Recordset, _
ByRef lngTokenCounter As Long) As String
Const C_TOKEN_PREFIX As String = “@txt”
Const C_DOUBLE_QUOTE As String = “”””
```
Dim strResult As String
Dim strOriginalString As String
Dim strTokenName As String
Dim lngPos As Long
Dim lngStartPos As Long
Dim lngEndPos As Long
Dim blnInString As Boolean
Dim strChar As String
Dim strNextChar As String
strResult = ""
lngPos = 1
blnInString = False
lngStartPos = 0
'1文字ずつ走査
Do While lngPos <= Len(strCode)
strChar = Mid(strCode, lngPos, 1)
If lngPos < Len(strCode) Then
strNextChar = Mid(strCode, lngPos + 1, 1)
Else
strNextChar = ""
End If
'文字列リテラルの開始・終了を判定
If strChar = C_DOUBLE_QUOTE Then
If Not blnInString Then
'文字列リテラルの開始
blnInString = True
lngStartPos = lngPos
Else
'エスケープ（""）のチェック
If strNextChar = C_DOUBLE_QUOTE Then
'エスケープされたダブルクォート→スキップ
lngPos = lngPos + 1
Else
'文字列リテラルの終了
lngEndPos = lngPos
'元の文字列を抽出（ダブルクォート含む）
strOriginalString = Mid(strCode, lngStartPos, lngEndPos - lngStartPos + 1)
'トークン名を生成
strTokenName = C_TOKEN_PREFIX & Format(lngTokenCounter, "000")
'トークン管理テーブルに登録
With rstToken
.AddNew
!TokenName = strTokenName
!OriginalString = strOriginalString
!CodeLineID = lngCodeLineID
.Update
End With
'結果文字列にトークンを追加
strResult = strResult & strTokenName
'カウンタをインクリメント
lngTokenCounter = lngTokenCounter + 1
blnInString = False
End If
End If
Else
'文字列リテラル外の文字はそのまま追加
If Not blnInString Then
strResult = strResult & strChar
End If
End If
lngPos = lngPos + 1
Loop
fncTokenizeString = strResult
```
End Function
共通