Macro Word Substituir

Question

Prezados:

Utilizo a macro abaixo para alterar a formatação de vários arquivos de forma automática.

Seria possível adaptar para fazer substituições?

Ou seja, procura em c:\word\, todos os arquivos que ali tiver, abre um por um, procura a palavra a ser substituída, se encontrar faz a substituição, salva e fecha.

Grato

AdrianoPires

Sub pMain()
  'Altere aqui o caminho do diretório que contém os arquivos que você quer formatar.
  Const csDiretório As String = "c:\WORD\"
 
  Dim doc As Word.Document
  Dim oFile As Object 'Scripting.File
  Dim oFolder As Object 'Scripting.Folder
  Dim oFSO As Object 'Scripting.FileSystemObject
 
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oFolder = oFSO.GetFolder(csDiretório)
  For Each oFile In oFolder.Files
    If LCase(oFSO.GetExtensionName(oFile.Path)) Like "doc*" Then
      Set doc = Documents.Open(oFile.Path)
      doc.Content.Select
      Selection.Style = doc.Styles(wdStyleNormal)
      Selection.Font.Color = wdColorBlack
      Selection.Font.Bold = False
      Selection.Font.Italic = False
      Selection.Font.Size = 11
      Selection.Font.Name = "ARIAL"
      Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
      doc.PageSetup.TopMargin = 25
      doc.PageSetup.BottomMargin = 25
      doc.PageSetup.LeftMargin = 25
      doc.PageSetup.RightMargin = 25
      doc.ActiveWindow.ActivePane.View.Zoom.Percentage = 78
      doc.Close SaveChanges:=wdSaveChanges
      DoEvents
    End If
  Next oFile
End Sub

Answer 1

Ao inserir um código no fórum, utilize blocos de código. Para utilizar essa ferramenta, clique no botão cuja legenda é “Inserir bloco de código” na barra do editor de mensagens do fórum. Uma janela aparecerá onde você deverá colar seu código cru na caixa de texto à esquerda. Então, selecione a opção Vb.Net na caixa de combinação que você verá em cima à esquerda e depois clique no botão Inserir.

---

Sobre seu código, ele já faz o que você quer, não?

---

http://www.ambienteoffice.com.br - http://www.clarian.com.br

Answer 2

Felipe,

Obrigado pela atenção, quanto ao código não sabia dessa regra, me desculpe.

Esse código não faz o quero, ele faz a formatação do arquivo, tamanho da letra, alinhamento,zoom, etc.

O que quero é que faça substituição de palavras de forma automática.

Ou seja, que vá na pasta indicada, abra arquivo por arquivo, substitua a palavra estabelecida,salve o arquivo e feche, como este código faz com a formatação.

Agrqadeco se puder ajudar.

AdrianoPires

Answer 3

Já tentou isso?

Sub pMain()
  'Altere aqui o caminho do diretório que contém os arquivos que você quer formatar.
  Const csDiretório As String = "c:\WORD\"
  
  Dim doc As Word.Document
  Dim oFile As Object 'Scripting.File
  Dim oFolder As Object 'Scripting.Folder
  Dim oFSO As Object 'Scripting.FileSystemObject
  
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oFolder = oFSO.GetFolder(csDiretório)
  For Each oFile In oFolder.Files
    If LCase(oFSO.GetExtensionName(oFile.Path)) Like "doc*" Then
      Set doc = Documents.Open(oFile.Path)
        Selection.Find.Execute FindText:="Texto Procurado", _
                               ReplaceWith:="Text Substituído", _
                               Wrap:=wdFindContinue
      DoEvents
    End If
  Next oFile
End Sub

---

http://www.ambienteoffice.com.br - http://www.clarian.com.br

Answer 4

Felipe,

É isso mesmo, mas o código só procura uma vez no documento e faz a substituição.

Acontece que nos documentos o "Texto Procurado" aparece diversas vezes e o código só faz a verificação na primeira vez que aparece, as demais não faz.

Tem como fazer a primeira alteração e continuar procurando?

Não estava salvando e fechando, mas inclui a linha doc.Close SaveChanges:=wdSaveChanges e está ok.

Grato

AdrianoPires

Answer 5

Sub Main()
    'Altere aqui o caminho do diretório que contém os arquivos que você quer formatar.
    Const csDiretório As String = "c:\WORD\"
  
    Dim doc As Word.Document
    Dim oFile As Object 'Scripting.File
    Dim oFolder As Object 'Scripting.Folder
    Dim oFSO As Object 'Scripting.FileSystemObject
  
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(csDiretório)
    For Each oFile In oFolder.Files
        If Not LCase(oFSO.GetExtensionName(oFile.Path)) Like "doc*" Then GoTo Continue
        Set doc = Documents.Open(oFile.Path)
        Selection.Find.Execute FindText:="Texto Procurado", _
                               ReplaceWith:="Text Substituído", _
                               Replace:=wdReplaceAll, _
                               Wrap:=wdFindContinue
        doc.Close SaveChanges:=wdSaveChanges
        DoEvents
Continue:
    Next oFile
End Sub

---

http://www.ambienteoffice.com.br - http://www.clarian.com.br

Answer 6

Boa Tarde Felipe,

Funcionou direitinho.

Obrigado pela ajuda.

AdrianoPires