📄 form2-26.frm
字号:
Set rsTemp = db.OpenRecordset("select * from " & Tempdbname & "")
Open file_name For Input As #1
file_newline = ""
Do Until EOF(1) '循环读入文件的每一行，直到文件结束
file_newline = ""
Line Input #1, file_newline '读入一行
file_newline = Trim(file_newline) '去掉多余的空格
IDnum = 0
Parentnum = 0
relname = "空"
str = ""
If (InStr(file_newline, "<body>") <> 0) Then '先找到<body>
B = 1 '一个body的操作刚开始
End If
If (InStr(file_newline, "</body>") <> 0) Then '找到</body>
B = 0 '一个body的操作结束了
End If
If B = 1 And (InStr(file_newline, "<segment") <> 0) Then '找到<segment
i = InStr(file_newline, "id") 'id的位置
str = ""
If (i <> 0) Then '得到id号
While (Mid(file_newline, i + 4, 1) <> Chr(34))
str = str & Mid(file_newline, i + 4, 1)
i = i + 1
Wend
IDnum = Val(str)
End If
i = InStr(file_newline, "parent") 'parent的位置
str = ""
If (i <> 0) Then '得到parent值
While (Mid(file_newline, i + 8, 1) <> Chr(34))
str = str & Mid(file_newline, i + 8, 1)
i = i + 1
Wend
Parentnum = Val(str)
End If
i = InStr(file_newline, "relname") 'relname的位置
str = ""
If (i <> 0) Then '得到relname值
While (Mid(file_newline, i + 9, 1) <> Chr(34))
str = str & Mid(file_newline, i + 9, 1)
i = i + 1
Wend
relname = str
End If
'从文字里找标点符号，找到了再往表里填写
i = InStr(file_newline, ">") '>的位置
str = ""
If (i <> 0) Then '取 > 到 </segment> 的值
j = InStr(file_newline, "</segment>") '</segment>的位置
If (j <> 0) Then
str = Mid(file_newline, i + 1, j - i - 1)
Else
str = Mid(file_newline, i + 1)
Line Input #1, file_newline
j = InStr(file_newline, "</segment>")
While (j = 0)
str = str & file_newline
Input #1, file_newline
j = InStr(file_newline, "</segment>")
Wend
str = str & Mid(file_newline, 1, j - 1)
End If
End If
rsTemp.AddNew '加一条新记录
file_name = Mid(file_name, (InStrRev(file_name, "\") + 1)) '把路径去掉
rsTemp.Fields("文件名").Value = file_name '把字段文件名的值加到表中
rsTemp.Fields("segmentid").Value = IDnum
rsTemp.Fields("parentid").Value = Parentnum
rsTemp.Fields("关系1").Value = relname
rsTemp.Update
If InStr(str, Text1.Text) <> 0 Then
P = 1
End If
If P = 1 Then
rs.AddNew '加一条新记录
file_name = Mid(file_name, (InStrRev(file_name, "\") + 1)) '把路径去掉
rs.Fields("文件名").Value = file_name '把字段文件名的值加到表中
rs.Fields("记录号").Value = num '把字段记录名的值加到表中
num = num + 1
rs.Fields("segmentid").Value = IDnum
rs.Fields("parentid").Value = Parentnum
rs.Fields("关系1").Value = relname
rs.Fields("文字").Value = str
If StrComp(relname, "span") <> 0 Then
rs.Fields("核心性").Value = "S"
Else
rs.Fields("核心性").Value = "N"
End If
rs.Update
P = 0
End If
End If 'segment结束
If B = 1 And (InStr(file_newline, "<group") <> 0) Then '找到<group
i = InStr(file_newline, "id") 'id的位置
str = ""
If (i <> 0) Then '得到id号
While (Mid(file_newline, i + 4, 1) <> Chr(34))
str = str & Mid(file_newline, i + 4, 1)
i = i + 1
Wend
IDnum = Val(str)
End If
i = InStr(file_newline, "parent") 'parent的位置
str = ""
If (i <> 0) Then '得到parent值
While (Mid(file_newline, i + 8, 1) <> Chr(34))
str = str & Mid(file_newline, i + 8, 1)
i = i + 1
Wend
Parentnum = Val(str)
End If
i = InStr(file_newline, "relname") 'relname的位置
str = ""
If (i <> 0) Then '得到relname值
While (Mid(file_newline, i + 9, 1) <> Chr(34))
str = str & Mid(file_newline, i + 9, 1)
i = i + 1
Wend
relname = str
End If
rsTemp.AddNew '加一条新记录
file_name = Mid(file_name, (InStrRev(file_name, "\") + 1)) '把路径去掉
rsTemp.Fields("文件名").Value = file_name '把字段文件名的值加到表中
rsTemp.Fields("segmentid").Value = IDnum
rsTemp.Fields("parentid").Value = Parentnum
rsTemp.Fields("关系1").Value = relname
rsTemp.Update
End If
Loop 'while语句结束，用来读文件的每一行
'处理完一个文件了
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Set rsN = db.OpenRecordset("select * from " & dbname & " where 核心性='N' and 记录号>= " & num1 & "")
num1 = num
If rsN.RecordCount > 0 Then
'count = rsTemp.RecordCount
rsN.MoveLast
count = rsN.RecordCount
rsN.MoveFirst '从第一个记录开始查找
'Print count
For j = 1 To count
rsTemp.MoveFirst
i = rsN.Fields("segmentid").Value
'Print i
rsTemp.FindFirst "parentid=" & i & ""
If rsTemp.NoMatch = True Then
MsgBox "对不起,没有该记录"
Print rsN.Fields("segmentid").Value
Else
str = rsTemp.Fields("关系1").Value
'Print str
rsN.Edit
rsN.Fields("关系2") = str
rsN.Update
End If
'i = rs.Fields("parentid").Value
str = rsN.Fields("关系2").Value
While str = "span"
i = rsTemp.Fields("segmentid").Value
rsTemp.MoveFirst
rsTemp.FindFirst "parentid=" & i & ""
If rsTemp.NoMatch = True Then
MsgBox "对不起,没有该记录--"
Else
str = rsTemp.Fields("关系1").Value
'Print str
rsN.Edit
rsN.Fields("备注") = str
rsN.Update
End If
Wend
rsN.MoveNext 'span处理完后必须把记录指针调到数据库尾部
Next j
End If
rs.Close
rsTemp.Close
rsN.Close
Close #1 '关闭打开的文件，这样可以再循环的时候打开另一个文件
Next k 'For语句结束，用来提供单个或者多个文件名
MsgBox "程序运行结束", , "提示信息"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -