PDA

View Full Version : HTML tags in VBA code



Ai_BG
09-18-2018, 12:45 AM
I am trying to create an application where I have three text boxes. In textbook 1, a
text should be filled in, which in text boxes 2 and 3 will extract parts of the text from text box 1 marked with tags.

Example of text:
The customer will order a <color> blue </ sweater> and it should be in size <size> medium </ size>

How should I declare the code? I want to use the mid() function to search the text, but dont know how to do that with two types of "tags"

OBP
09-18-2018, 04:16 AM
You will probably want to use the Instr() function as well as Left(), Mid() & Right() string functions in this post.
This code shows how they can be used.

Parse Text data in to two tables.

Private Sub Cmd_Trf_Record_Accepted_Click()
Dim data As String, count As Integer, count2 As Integer, Start As Integer, finish As Integer, rstable As Object
Dim recount As Integer, fname As String, start2 As Integer, records As Integer, rs As Object, x As Integer
Dim first As Integer, fieldcount As Integer, rs2 As Object
On Error GoTo errorcatch
Set rstable = CurrentDb.OpenRecordset("PA_Accepted")
Set rs = CurrentDb.OpenRecordset("tblone")
fieldcount = rs.Fields.count
rstable.MoveLast
recount = rstable.RecordCount
rstable.MoveFirst
For records = 2 To recount
x = x + 1
rs.AddNew
rstable.MoveNext
count2 = 1
data = rstable.Field1
Start = 1
For count = 1 To Len(data)
If Mid(data, count, 1) = "|" Then
fname = Mid(data, Start, (count - Start))
Start = count + 1
count2 = count2 + 1
If Not IsNull(fname) And fname <> "" Then
rs(count2 - 1).Value = fname
Else
rs(count2 - 1).Value = Null
End If
End If
If count2 = fieldcount Then Exit For
Next count
rs.Update
rs.Bookmark = rs.LastModified
Set rs2 = CurrentDb.OpenRecordset("tbltwo")
rs2.AddNew
first = InStr(1, data, "|")

count2 = 1
rs2(count2 - 1).Value = Left(data, first - 1)
start2 = Start
For count = start2 To Len(data) - 1
If Mid(data, count, 1) = "|" Then
fname = Mid(data, start2, (count - start2))
start2 = count + 1
count2 = count2 + 1
If Not IsNull(fname) And fname <> "" Then
rs2(count2 - 1).Value = fname
Else
rs2(count2 - 1).Value = Null
End If
End If
Next count
'add Last Fields data
fname = Right(data, ((count + 1) - start2))
If Not IsNull(fname) And fname <> "" Then
rs2(count2).Value = fname
Else
rs2(count2).Value = Null
End If
rs2.Update
rs2.Bookmark = rs2.LastModified
Next records
rs.Close
Set rs = Nothing
rs2.Close
Set rs2 = Nothing
rstable.Close
Set rstable = Nothing
MsgBox "added " & x & " records"
Exit Sub
errorcatch:
MsgBox records & " " & count & " " & count2 & " " & Err.Description & " " & fname
Resume Next
End Sub