请教各位高手，利用DAO提取主题词

guoya

我想编写一个从主题词表中用DAO自动提起主题词通过提取主题词的程序，代码如下：
但是需要改进，主要是提取的主题词中有从属的词要剔除，请教各位高手。
Private Sub Command12_Click()
Dim I As Integer '利用mid函数提取比较词开始位置
Dim N As Integer 'mid函数提取比较词长度
Dim StrZTC As String '定义提取比较的主题词变量
Dim rs As DAO.Recordset '定义主题词表数据集
Dim Strtm  As String '定义题名变量
Dim StrKeyWord As String '定义主题词变量
Dim StrTmp As String '定义临时词变量,用于剔除重复的主题词
Strtm = Nz(Me.题名)
If IsNull(Strtm) = True Then Exit Sub
If Left(Strtm, 4) = "关于转发" Or Left(Strtm, 4) = "关于印发" Then
    Strtm = Right(Strtm, Len(Strtm) - 4)
End If
If Left(Strtm, 2) = "关于" Then
    Strtm = Right(Strtm, Len(Strtm) - 2)
End If
Set rs = CurrentDb.OpenRecordset("主题词表", dbOpenTable)
rs.Index = "非正式主题词"
For I = 1 To Len(Strtm)
    For N = 2 To Len(Strtm) - I + 1
        StrZTC = Mid(Strtm, I, N) '取出一个比较词
        rs.Seek "=", StrZTC
        If rs.NoMatch = False Then
            '下一个if语句意图剔除主题词集中的重复和笼统的主题词，但结果有误
            'If InStr(1, rs("主题词"), StrTmp) = 1 Then'对找到的两个主题词进行比较，如果新的主题词包含上一个主题词则为真
                'StrKeyWord = Left(StrKeyWord, Len(StrKeyWord) - InStrRev(StrKeyWord, ",") + 1)'剔除右边起有逗号","的部分
            'End If
            StrKeyWord = StrKeyWord & "," & rs("主题词")
            'StrTmp = StrZTC'保留当前主题词以便进行比较
        End If

    Next N
Next I
If StrKeyWord = "" Then
    Me.主题词 = ""
Else
    Me.主题词 = Right(StrKeyWord, Len(StrKeyWord) - 1)
End If
End Sub

guoya

上传附件