Substituir texto no Word dentro de uma Caixa de Texto no vba

Pessoal, bom dia! Poderiam me dar uma ajuda?
Eu tenho o código abaixo que utilizo no access para preencher um arquivo word através de informações do banco de dados, tudo estava funcionando perfeitamente até incluírem no modelo campos que estão dentro de caixas de textos. Ocorre que agora não consigo localizar as informações que estão dentro de caixas de textos para substituir.

Segue código abaixo, a parte que está como comentário é justamente a parte em que os campos estão dentro de caixas de textos.


Public Function Fncmesclar()

On Error GoTo TrataErro
Dim strLocal As String
Dim WORD As WORD.Application
Dim DOC As WORD.Document

Set WORD = CreateObject("Word.Application")
WORD.Visible = True

Set DOC = WORD.Documents.Open("C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\" + "Vincular\" + "CONTESTAÇÃO" + "-" + Me.POLO_ATIVO + "-" + "ADV " + Me.ADVOGADO_AUTOR_NOME + "-" + Me.UF + ".docx")


With DOC

.Application.Selection.Find.Text = "#FORO"
.Application.Selection.Find.Execute
.Application.Selection.Range = FORO

.Application.Selection.Find.Text = "#COMARCA"
.Application.Selection.Find.Execute
.Application.Selection.Range = COMARCA

.Application.Selection.Find.Text = "#UF"
.Application.Selection.Find.Execute
.Application.Selection.Range = UCase(UF)

.Application.Selection.Find.Text = "#PROCESSO_NUMERO"
.Application.Selection.Find.Execute
.Application.Selection.Range = PROCESSO_NUMERO

.Application.Selection.Find.Text = "#POLO_ATIVO"
.Application.Selection.Find.Execute
.Application.Selection.Range = POLO_ATIVO

.Application.Selection.Find.Text = "#COBRANCA_VALOR"
.Application.Selection.Find.Execute
.Application.Selection.Range = COBRANCA_VALOR

.Application.Selection.Find.Text = "#CONTRATO"
.Application.Selection.Find.Execute
.Application.Selection.Range = CONTRATO

If Me.RESUMO_DEFESA Like "*Prescrição*" Then
.Application.Selection.Find.Text = "#NEGATIVACAO_DATA"
.Application.Selection.Find.Execute
.Application.Selection.Range = NEGATIVACAO_DATA

.Application.Selection.Find.Text = "#DISTRIBUICAO_DATA"
.Application.Selection.Find.Execute
.Application.Selection.Range = DISTRIBUICAO_DATA

'.Application.Selection.Find.Text = "#DATA_NEGATIVACAO"
' .Application.Selection.Find.Execute
'.Application.Selection.Range = NEGATIVACAO_DATA

' .Application.Selection.Find.Text = "#PRESCRICAO_DATA"
' .Application.Selection.Find.Execute
'.Application.Selection.Range = PRESCRICAO_DATA

'.Application.Selection.Range = DateAdd("aaaa", 3, NEGATIVACAO_DATA)

'.Application.Selection.Find.Text = "#DATA_DISTRIBUICAO"
'.Application.Selection.Find.Execute
' .Application.Selection.Range = DISTRIBUICAO_DATA

End If

.Application.Selection.Find.Text = "#RESIDENCIA"
.Application.Selection.Find.Execute
.Application.Selection.InlineShapes.AddPicture FileName:="C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\residencia.jpg", LinkToFile:=False, SaveWithDocument:=True

.Application.Selection.Find.Text = "#SERASA"
.Application.Selection.Find.Execute
.Application.Selection.InlineShapes.AddPicture FileName:="C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\serasa.jpg", LinkToFile:=False, SaveWithDocument:=True

.Application.Selection.Find.Text = "#LINHA"
.Application.Selection.Find.Execute
.Application.Selection.Range = LINHA

.Application.Selection.Find.Text = "#CONTRATO"
.Application.Selection.Find.Execute
.Application.Selection.Range = CONTRATO

.Application.Selection.Find.Text = "#LINHA_CONTRATACAO"
.Application.Selection.Find.Execute
.Application.Selection.Range = LINHA_CONTRATACAO

.Application.Selection.Find.Text = "#LINHA_CANCELAMENTO"
.Application.Selection.Find.Execute
.Application.Selection.Range = LINHA_CANCELAMENTO

'.Application.Selection.Find.Text = "#LINHA_CONTRATACAO"
' .Application.Selection.Find.Execute
'.Application.Selection.Range = LINHA_CONTRATACAO

' .Application.Selection.Find.Text = "#PAGAMENTO_1"
' .Application.Selection.Find.Execute
'.Application.Selection.Range = PAGAMENTO_1

' .Application.Selection.Find.Text = "#PAGAMENTO_ULTIMO"
' .Application.Selection.Find.Execute
' .Application.Selection.Range = PAGAMENTO_ULTIMO

'.Application.Selection.Find.Text = "#LINHA_CANCELAMENTO"
' .Application.Selection.Find.Execute
' .Application.Selection.Range = LINHA_CANCELAMENTO

' .Application.Selection.Find.Text = "#NEGATIVACAO_DATA"
' .Application.Selection.Find.Execute
' .Application.Selection.Range = NEGATIVACAO_DATA


.Application.Selection.Find.Text = "#TELA DE CADASTRO"
.Application.Selection.Find.Execute
.Application.Selection.InlineShapes.AddPicture FileName:="C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\tela de cadastro.jpg", LinkToFile:=False, SaveWithDocument:=True

.Application.Selection.Find.Text = "#TELA DE ACESSO"
.Application.Selection.Find.Execute
.Application.Selection.InlineShapes.AddPicture FileName:="C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\tela de acesso.jpg", LinkToFile:=False, SaveWithDocument:=True

.Application.Selection.Find.Text = "#TELA DE ENDEREÇO"
.Application.Selection.Find.Execute
.Application.Selection.InlineShapes.AddPicture FileName:="C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\tela de endereco.jpg", LinkToFile:=False, SaveWithDocument:=True

.Application.Selection.Find.Text = "#TELA DE PAGAMENTOS"
.Application.Selection.Find.Execute
.Application.Selection.InlineShapes.AddPicture FileName:="C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\tela de pagamentos.jpg", LinkToFile:=False, SaveWithDocument:=True

.Application.Selection.Find.Text = "#TELA DE DEBITOS"
.Application.Selection.Find.Execute
.Application.Selection.InlineShapes.AddPicture FileName:="C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\tela de debitos.jpg", LinkToFile:=False, SaveWithDocument:=True

.Application.Selection.Find.Text = "#DEBITO_VALOR"
.Application.Selection.Find.Execute
.Application.Selection.Range = DEBITO_VALOR

.Application.Selection.Find.Text = "#DEBITO_VALOR"
.Application.Selection.Find.Execute
.Application.Selection.Range = DEBITO_VALOR

.Save
If MsgBox("Deseja fechar a defesa", vbYesNo) = vbYes Then
.Close

End If
'strLocal = "C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" & Me.POLO_ATIVO & " - " & Me.PROCESSO_NUMERO & " - " & Me.ESTADO & "\" & "Vincular\" & Me.POLO_ATIVO & ".docx"
'strLocal = strLocal & "-" & Format(Now, "hhmmss") & ".docx"
'.ActiveDocument.SaveAs strLocal
'.ActiveDocument.Close

'.ActiveDocument.SaveAs "C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\" + "Vincular\" + "CONTESTAÇÃO" + "-" + Me.POLO_ATIVO + "-" + "ADV " + Me.ADVOGADO_AUTOR_NOME + "-" + Me.UF + ".docx"
'.ActiveDocument.SaveAs "C:\" & "LDB_PF " & Replace(Me.POLO_ATIVO, "/", "-") & ".docX"


'.Close
End With

'WORD.Quit
Set DOC = Nothing
Set WORD = Nothing

TrataErro:
'Se um campo do formulário estiver vazio, remove o texto do Indicador e continua
If Err.Number = 94 Or Err.Number = 424 Or Err.Number = 5152 Then
WORD.Application.Selection.Range = ""
Resume Next
End If

End Function

Public Function Fncmesclarscore()

On Error GoTo TrataErro
Dim strLocal As String
Dim WORD As WORD.Application
Dim DOC As WORD.Document

Set WORD = CreateObject("Word.Application")
WORD.Visible = True

Set DOC = WORD.Documents.Open("C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\" + "Vincular\" + "CONTESTAÇÃO" + "-" + Me.POLO_ATIVO + "-" + "ADV " + Me.ADVOGADO_AUTOR_NOME + "-" + Me.UF + ".docx")
'Set DOC = WORD.Documents.Open("D:\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\" + "Vincular\" + "CONTESTAÇÃO" + "-" + Me.POLO_ATIVO + "-" + "ADV " + Me.ADVOGADO_AUTOR_NOME + "-" + Me.UF + ".docx")

With DOC

.Application.Selection.Find.Text = "#FORO"
.Application.Selection.Find.Execute
.Application.Selection.Range = FORO

.Application.Selection.Find.Text = "#COMARCA"
.Application.Selection.Find.Execute
.Application.Selection.Range = COMARCA

.Application.Selection.Find.Text = "#UF"
.Application.Selection.Find.Execute
.Application.Selection.Range = UCase(UF)

.Application.Selection.Find.Text = "#PROCESSO_NUMERO"
.Application.Selection.Find.Execute
.Application.Selection.Range = PROCESSO_NUMERO

.Application.Selection.Find.Text = "#POLO_ATIVO"
.Application.Selection.Find.Execute
.Application.Selection.Range = POLO_ATIVO

.Application.Selection.Find.Text = "#COBRANCA_VALOR"
.Application.Selection.Find.Execute
.Application.Selection.Range = COBRANCA_VALOR

.Application.Selection.Find.Text = "#CONTRATO"
.Application.Selection.Find.Execute
.Application.Selection.Range = CONTRATO

.Application.Selection.Find.Text = "#NEGATIVACAO_DATA"
.Application.Selection.Find.Execute
.Application.Selection.Range = NEGATIVACAO_DATA

.Application.Selection.Find.Text = "#DISTRIBUICAO_DATA"
.Application.Selection.Find.Execute
.Application.Selection.Range = DISTRIBUICAO_DATA

.Application.Selection.Find.Text = "#RESIDENCIA"
.Application.Selection.Find.Execute
.Application.Selection.InlineShapes.AddPicture FileName:="C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\residencia.jpg", LinkToFile:=False, SaveWithDocument:=True

.Application.Selection.Find.Text = "#SERASA"
.Application.Selection.Find.Execute
.Application.Selection.InlineShapes.AddPicture FileName:="C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\serasa.jpg", LinkToFile:=False, SaveWithDocument:=True

.Application.Selection.Find.Text = "#LINHA"
.Application.Selection.Find.Execute
.Application.Selection.Range = LINHA

.Application.Selection.Find.Text = "#CONTRATO"
.Application.Selection.Find.Execute
.Application.Selection.Range = CONTRATO

.Application.Selection.Find.Text = "#LINHA_CONTRATACAO"
.Application.Selection.Find.Execute
.Application.Selection.Range = LINHA_CONTRATACAO

.Application.Selection.Find.Text = "#LINHA_CANCELAMENTO"
.Application.Selection.Find.Execute
.Application.Selection.Range = LINHA_CANCELAMENTO

.Application.Selection.Find.Text = "#DEBITO_VALOR"
.Application.Selection.Find.Execute
.Application.Selection.Range = DEBITO_VALOR

.Application.Selection.Find.Text = "#DEBITO_VALOR"
.Application.Selection.Find.Execute
.Application.Selection.Range = DEBITO_VALOR

.Save
.Close

'strLocal = "C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" & Me.POLO_ATIVO & " - " & Me.PROCESSO_NUMERO & " - " & Me.ESTADO & "\" & "Vincular\" & Me.POLO_ATIVO & ".docx"
'strLocal = strLocal & "-" & Format(Now, "hhmmss") & ".docx"
'.ActiveDocument.SaveAs strLocal
'.ActiveDocument.Close

'.ActiveDocument.SaveAs "C:\Users\Patrick\OneDrive\CMartins\Patrick\Defesas\" + Me.POLO_ATIVO + " - " + Me.PROCESSO_NUMERO + " - " + Me.ESTADO + "\" + "Vincular\" + "CONTESTAÇÃO" + "-" + Me.POLO_ATIVO + "-" + "ADV " + Me.ADVOGADO_AUTOR_NOME + "-" + Me.UF + ".docx"
'.ActiveDocument.SaveAs "C:\" & "LDB_PF " & Replace(Me.POLO_ATIVO, "/", "-") & ".docX"


'.Close
End With

'WORD.Quit
Set DOC = Nothing
Set WORD = Nothing

TrataErro:
'Se um campo do formulário estiver vazio, remove o texto do Indicador e continua
If Err.Number = 94 Or Err.Number = 424 Or Err.Number = 5152 Then
WORD.Application.Selection.Range = ""
Resume Next
End If

End Function

Boa noite,
Já procurou em fóruns word? Apesar de ser trabalhado a partir do Access, trata-se de trabalho no word

Não vejo como sendo de word, o meu código funcionava perfeitamente, o código que não encontra o campo no arquivo para substituir, salvo engano eu vi um código na internet que informaram que funcionaria, mas era para outra linguagem de programação, mas queria pro VBA

Se alteraram para caixas de texto, terá de refazer todo o seu código.

Num pequeno teste que fiz aqui para lhe mostrar o caminho das pedras;

1º Abri um documento word em branco
2º Adicionei uma caixa de texto (sharpe)
3º Escrevi nessa caixa, o texto "teste"
4º Salvei o documento em C:\TEMP\teste.docx
5º Corri este pequeno código em VBA no MsAccess 2016

Funcionou plenamente;

Código:

Sub AlteraTexto()
Dim Word As Word.Application
Dim DOC As Word.Document

Set Word = CreateObject("Word.Application")
Word.Visible = True

Set DOC = Word.Documents.Open("C:\temp\teste.docx")

With DOC.Shapes("Text Box 1").TextFrame.TextRange.Find
      .Text = "teste"
      .Replacement.Text = "teste2022"
      .Wrap = wdFindContinue
      .MatchWholeWord = True
      .Execute Replace:=wdReplaceAll
   End With
End Sub

Muito obrigado JPaulo, irei testar e retornar aqui no forum

JPAULO eu ainda não tentei aplicar no meu sistema, pois estou fazendo testes no modelo que você enviou e de fato o código permite localizar o campo dentro da caixa de texto e substituir, mas estou com dificuldades para aplicar em várias caixas de texto e ao mesmo tempo em campos que estejam fora da caixa de texto, caso possa gentilmente me ajudar novamente, agradeço.

Amigão fora da caixa de texto já você tinha a funcionar.
Se acrescentar mais caixas de texto, então terá de invocar o nome delas, que será sempre pela ordem que adicionar:
("Text Box 1")
("Text Box 2")
("Text Box 3")
("Text Box 4")
Etc...

Eu tentei mesclar o condigo anterior com este para localizar e substituir as caixas de texto, mas aparece uma mensagem de erro " Erro de compilação, uso invalido de propriedade" na linha " .Shapes("Text Box 1").TextFrame.TextRange.Find".

Segue uma parte do código, não sei onde está o erro:



.Application.Selection.Find.Text = "#LINHA_CANCELAMENTO"
.Application.Selection.Find.Execute
.Application.Selection.Range = LINHA_CANCELAMENTO

.Shapes("Text Box 1").TextFrame.TextRange.Find
.Text = "#LINHA_CONTRATACAO"
.Replacement.Text = LINHA_CONTRATACAO
.Wrap = wdFindContinue
.MatchWholeWord = True
.Execute Replace:=wdReplaceAll