• Home

Sub btnKeywords_Click()

Sub btnKeywords_Click ()

    Dim UtilVart0 As Variant
    Dim UtilVart1 As Variant
    Dim UtilVart2 As Variant
    Dim UtilVart3 As Variant
    Dim UtilStrg0 As String
    Dim UtilStrg1 As String
    Dim UtilLong0 As Long
    Dim UtilIntg0 As Integer
    Dim KeyDB As Database
    Dim KeySet As Recordset

    UtilVart0 = Null
    UtilVart1 = Null
    UtilVart2 = Null

    On Error GoTo Err_btnKeywords_Click

'Form SQL string for opening the SINDIVID records.
    UtilStrg0 = "SELECT SINDIVID.PersKey, SINDIVID.Lastname, SINDIVID.Firstname, SINDIVID.Middname, SINDIVID.Company, SINDIVID.Search_Words FROM SINDIVID;"
    Set KeyDB = DBEngine.Workspaces(0).Databases(0)
    Set KeySet = KeyDB.OpenRecordset(UtilStrg0, DB_OPEN_DYNASET)

'Determine number of records so that a progress meter can be displayed.
    KeySet.MoveLast
    UtilLong0 = KeySet.RecordCount
    UtilIntg0 = 0
    UtilVart3 = SysCmd(SYSCMD_INITMETER, "Updating search words...", UtilLong0)
    DoCmd Hourglass True
    
'Now begin developing search, or key words for each individual's
'help file topic.
    KeySet.MoveFirst
    Do Until KeySet.EOF
        UtilVart3 = SysCmd(SYSCMD_UPDATEMETER, UtilIntg0)
        UtilVart0 = KeySet![Firstname]
        UtilVart1 = KeySet![Middname]
        UtilVart2 = KeySet![Lastname]
'Make whole name with firstname, middle, and lastname.
        UtilStrg0 = ""
        If IsNull(UtilVart0) Then
            UtilStrg0 = ""
        Else
            UtilStrg0 = UtilVart0 & " "
        End If
'Add middle name.
        If Not IsNull(UtilVart1) Then
            If UtilStrg0 <> "" Then
                UtilStrg0 = UtilStrg0 & UtilVart1 & " "
            Else
                UtilStrg0 = UtilVart1 & " "
            End If
        End If
'Add last name.
        If UtilStrg0 = "" Then
            UtilStrg0 = UtilVart2
        Else
            UtilStrg0 = UtilStrg0 & UtilVart2
        End If
'Place in UtilStrg1 for accumulation of search words string.
        UtilStrg1 = UtilStrg0
'Now make whole name with lastname, firstname, and middle initial.
        UtilStrg0 = ""
        If IsNull(UtilVart0) Then
            UtilStrg0 = ""
        Else
            UtilStrg0 = ", " & UtilVart0
        End If
'Add middle name.
        If Not IsNull(UtilVart1) Then
            If UtilStrg0 <> "" Then
                UtilStrg0 = UtilStrg0 & " " & UtilVart1
            Else
                UtilStrg0 = ", " & UtilVart1
            End If
        End If
'Add last name.
        If UtilStrg0 = "" Then
            UtilStrg0 = UtilVart2
        Else
            UtilStrg0 = UtilVart2 & UtilStrg0
        End If
'Check if there is only a last name, and no first and-or
'middle name for this person.
'If so, do not make two identical search words.
        If UtilStrg0 <> UtilStrg1 Then
            UtilStrg1 = UtilStrg1 & ";" & UtilStrg0
        End If
'Finally, add employer, or company name as a search word.
        UtilVart0 = Null
        UtilVart0 = KeySet![Company]
        If Not IsNull(UtilVart0) Then
            UtilStrg1 = UtilStrg1 & ";" & UtilVart0
        End If
        KeySet.Edit
        KeySet![Search_Words] = UtilStrg1
        KeySet.Update
        KeySet.MoveNext
        UtilIntg0 = UtilIntg0 + 1
    Loop
    
    KeySet.Close
    KeyDB.Close

'Announce to user that job is finished.
    DoCmd Hourglass False
    UtilVart3 = SysCmd(SYSCMD_REMOVEMETER)
    UtilStrg0 = "DONE! There were " & UtilIntg0 & " records in SINDIVID updated "
    UtilStrg0 = UtilStrg0 & "with new Search, or Key Words."
    MsgBox UtilStrg0

Exit_btnKeywords_Click:
    Exit Sub

Err_btnKeywords_Click:
    MsgBox Error$
    Resume Exit_btnKeywords_Click

End Sub

• Home

See also:

• Differences Between Access Basic and VBA for Access 97