Busca em campo Memo por mais de uma palavra simultaneamente

Partindo do consagrado exemplo do Mestre João Paulo, uma adaptação para busca por mais de uma palavra simultaneamente:


>>>>> Aqui é necessário digitar as palavras separadas por uma "," (Vírgula) <<<<<<

Private Sub cmdEncontrar_Click()
On Error Resume Next
Dim StrBusca As String 'Variável do tipo String
Dim StrBuscaArray 'Variável do tipo Array
'Carrego a variável com o texto da caixa texto no form
StrBusca = Me.txtProcura
'Carrego a variável com o conteúdo da Variável StrBusca, separando-as pela vírgula, colocando cada palavra em uma posição da Array. Inicia na posição 0
StrBuscaArray = Split(StrBusca, ",")

'Utilizo o For para executar N Loops de acordo com a quantidade de posições dentro da Matriz, sendo a maior posição estraída pelo comando Ubound. Aqui a cada laço o valor de X é incrementado de acordo com a posição da informação na Matriz
For x = 0 To UBound(StrBuscaArray)

If IsNull(Me!CampoMemo) Or IsNull(Me!txtProcura) Then Exit Sub
Dim StrSelecao As Integer]
'Aqui a modificação para carregar a variável StrSeleção com o texto contido na Matriz na posição X (que será modificada a cada Volta)
StrSelecao = Len(StrBuscaArray(x))
If strPosicao = 0 Then strPosicao = 1
'Substituido conforme a busca. A ser executada na Matriz
strPosicao = InStr(strPosicao, Me!CampoMemo, StrBuscaArray(x))
If strPosicao > 0 Then
Me!CampoMemo.SetFocus
Me!CampoMemo.SelStart = strPosicao - 1
Me!CampoMemo.SelLength = StrSelecao
strPosicao = strPosicao + 1
Else
'Emite a menssagem para a palavra não encontrada
MsgBox "Não foi encontrada a seguinte palavra" & "'" & StrBuscaArray(x) & "'" & "", vbExclamation, "Erro"
'Vai para a o rótulo onde se inicia a busca pela próxima palavra
GoTo Continuar
strPosicao = 1
Dim rs As Recordset
Set rs = Me.RecordsetClone
rs.Bookmark = Me.Bookmark '
rs.MoveNext
If rs.EOF Then
If MsgBox("Procura terminada." & vbCrLf & "", vbDefaultButton2 + vbYesNo + vbQuestion, "Erro") = vbYes Then
rs.MoveFirst
Me.Bookmark = rs.Bookmark
Me!txtProcura = Null
Me!txtProcura.SetFocus
strContagem = 0
Else
End If
Else
Me.Bookmark = rs.Bookmark
End If
End If
'Vai para o proximo valor de X
Continuar: 'Não encontrada a palavra vai para este rotulo e por consequencia a proxima palavra
Next x
Set rs = Nothing
End Sub


Resumindo... Se digitarmos 2 palavras (Nome, Access)
A variável assumira a seguinte forma e posição:

StrBuscaArray(0) = Nome
StrBuscaArray(0) = Access

Assim se buscará todas as palavras.


https://dl.dropbox.com/u/26441349/BuscaMemo.rar

Cumprimentos.