[Resolvido]Formulário x Rotina Word com erro na variável

Boa noite.
Estou recebendo uma mensagem de erro quando executo uma rotina VBA criada no botão de comando do formulário para inserir dados em um documento Word.
Estou utilizando o ACCESS 2003 e o WORD 2003.

Anotações prévias:

1) A tabela : T40_RPR_Cadastro tem os campos:
CodRPR (Autonumeração)
NumRPR (Texto)
Data RPR (Data)
... Outros

2) A consulta: C40_RPR_PF_Relacionamento
CodRPRPessoa (Autonumeração)
IDCodRPR (Número. Inteiro longo)
CPFPessoa (Texto)
NomePessoa (Texto)
Relacionamento (Texto)

3) A consulta acima está baseada na tabela ‘T40_RPR_PessoaFisica’ e filtra pelo campo ‘Relacionamento’ para apresentar apenas os que contém "Titular" Ou "Comunicado" para ser usado no documento Word gerado pela rotina, conforme módulo acima.

4) A tabela ‘T40_RPR_Cadastro’ tem relacionamento um-para-vários com a tabela ‘T40_RPR_PessoaFisica’ (CodRPR x IDCodRPR)

Rotina do botão de comando:

Private Sub BtWord_Click()
'AUTORIA: Criquio - Fórum Máximo Access, com adaptações minhas
'OBRIGATÓRIO: Marcar Referência: Microsoft Word 11.0 Object Library
'             Marcar Referencia: Microsoft Scripting Runtime
Dim ntram
ntram = MsgBox("Deseja GERAR um novo Documento WORD ?" & vbCr & "ALERTA: Caso já tenha sido gerado o Relatório Preliminar do RIF anterior será substituído pelo Arquivo-Matriz!", vbQuestion + vbYesNo, "Sistema ARGUS - Confirmação")
If ntram = 6 Then 'INÍCIO 1º IF
  #Const DESENV = -1
  On Error GoTo TrataErro
  Dim oApp As Object 'Cria uma variável objeto
  Dim strSQL As String
  'Habilite a Referencia Microsoft Scripting Runtime
  'By JPaulo Maximo Access
  Dim Pasta As String
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.FolderExists("C:\ARGUS\14.RPRIF\" & Year(DataRPR)) Then ' verifica se já existe a pasta
     'Não faz nada
  Else
    'cria a pasta em falta para o ano em causa
    MkDir "C:\ARGUS\14.RPRIF\" & Year(DataRPR) ' se não existir cria
  End If
  Pasta = "C:\ARGUS\14.RPRIF\" & Year(DataRPR)
         
 'Inicia o MS Word
 Set oApp = CreateObject("Word.Application") 'Cria e abre o objeto Word
 With oApp
 'Torna o MS Word visível
 Visible = True
 'Abre o documento base
 .Documents.Open ("C:\ARGUS\00.MatrizWord\MatrizRPRIF.doc")

'Move cada campo para o indicador definido no documento
.ActiveDocument.Bookmarks("Campo01").Select
.Selection.Text = (CStr(Forms!F40_RPR_Cadastro!NumRPR))
.ActiveDocument.Bookmarks("Campo02").Select
.Selection.Text = (CStr(Forms!F40_RPR_Cadastro!IDEmitente))

... segue demais campos até ‘Campo15’ ...

'1ª ROTINA - FUNCIONOU (22/11/2017)
'Tabelas envolvidas: T40_RPR_Cadastro (PAI) + T40_RPR_Ocorrencias (FILHO)
Dim rst As DAO.Recordset, Ocorrencia As String
Set rst = CurrentDb.OpenRecordset("SELECT NomeOcorrencia FROM T40_RPR_Ocorrencias LEFT JOIN T40_RPR_Cadastro ON T40_RPR_Cadastro.CodRPR=T40_RPR_Ocorrencias.IDCodRPR WHERE CodRPR=" & CodRPR)
Ocorrencia = ""
Do While Not rst.EOF
If Ocorrencia = "" Then Ocorrencia = rst(0) Else Ocorrencia = Ocorrencia & vbCr & vbCr & rst(0) '04/08/2017: acrescentei mais um comando '& vbCr' para acrescentar mais um espaço entre os registros inseridos
  rst.MoveNext
Loop
Set rst = Nothing
.ActiveDocument.Bookmarks("Campo16").Select
.Selection.Text = Ocorrência
‘ PS: a rotina do ‘Campo16’ acima funciona perfeitamente

... segue demais comandos até o ‘Campo20’, onde está ocorrendo o erro (em negrito):

O erro é: “Erro 91 - A variável do objeto ou a variável do bloco 'With' não foi definida”.
PS: A Referencia Microsoft Word  11.0 Object Library está marcada.

'Objetos envolvidos: Tabela: T40_RPR_Cadastro + Consulta: C40_RPR_PF_Relacionamento

Dim rst2 As DAO.Recordset, Relacionamento As String
Set rst2 = CurrentDb.OpenRecordset("SELECT CPFPessoa, NomePessoa FROM C40_RPR_PF_Relacionamento LEFT JOIN T40_RPR_Cadastro ON T40_RPR_Cadastro.CodRPR=C40_RPR_PF_Relacionamento.IDCodRPR WHERE CodRPR=" & CodRPR)
Relacionamento = ""
Do While Not rst2.EOF
If Relacionamento = "" Then Relacionamento = rst2(0) & " - " & rst2(1) Else Relacionamento = Relacionamento & vbCr & rst2(0) & " - " & rst2(1)
  rst.MoveNext
Loop
Set rst2 = Nothing
.ActiveDocument.Bookmarks("Campo20").Select
.Selection.Text = Relacionamento

... segue demais comandos ...

End Sub

Alguém pode me apontar onde está o erro, ou se há uma forma melhor de construir tal rotina ?

PS: Segue arquivo compactado em anexo e orientações abaixo, caso queira testar o tópico em questão:

1) criar Pasta => C:\ARGUS  * Descompactar arquivo em anexo aqui
2) criar Pasta => C:\ARGUS\14.RPRIF
3) criar Pasta => C:\ARGUS\00.MatrizWord
4) copiar arquivo ‘MatrizRPRIF.doc’ para Pasta: C:\ARGUS\00.MatrizWord

Olá;

O problema está no que grifei a vermelho, que deverá ser rst2;

Dim rst2 As DAO.Recordset, Relacionamento As String
Set rst2 = CurrentDb.OpenRecordset("SELECT CPFPessoa, NomePessoa FROM C40_RPR_PF_Relacionamento LEFT JOIN T40_RPR_Cadastro ON T40_RPR_Cadastro.CodRPR=C40_RPR_PF_Relacionamento.IDCodRPR WHERE CodRPR=" & CodRPR)
Relacionamento = ""
Do While Not rst2.EOF
If Relacionamento = "" Then Relacionamento = rst2(0) & " - " & rst2(1) Else Relacionamento = Relacionamento & vbCr & rst2(0) & " - " & rst2(1) '12/09/2018: acrescentei mais um campo 'NomePessoa' e respectivos comandos de inserção
  rst.MoveNext
Loop
Set rst2 = Nothing

Olá,

Um grande pequeno erro de vista meu. Foi isso mesmo, valeu pela ajuda, muito obrigado.

Fico feliz
Obrigado pelo retorno o fórum agradece.