View Single Post
 
Old 12-25-2018, 04:02 AM
LG1972 LG1972 is offline Windows 7 64bit Office 2010
Novice
 
Join Date: Dec 2018
Posts: 1
LG1972 is on a distinguished road
Default Find and replace header text across multiple files

I'm looking for a macro that will allow me to find and replace header text across multiple files. I've tried editing macros I found for doing just that in word but with no luck. Can someone help me edit this macro so it will work with excel documents?

This is the word macro I have used:



Code:
Sub ReplaceTextInHeaderInMultiDoc()
  Dim StrFolder As String
  Dim strFile As String
  Dim objDoc As Document
  Dim dlgFile As FileDialog
  Dim strFindText As String
  Dim strReplaceText As String
 
  Set dlgFile = Application.FileDialog(msoFileDialogFolderPicker)
 
  With dlgFile
    If .Show = -1 Then
      StrFolder = .SelectedItems(1) & "\"
    Else
      MsgBox "Please select the target folder."
      Exit Sub
    End If
  End With
 
  strFindText = InputBox("Enter text to be found:", "Find Text")
  strReplaceText = InputBox("Enter new text:", "Replace Text")
 
  strFile = Dir(StrFolder & "*.docx", vbNormal)
 
  While strFile <> ""
    Set objDoc = Documents.Open(FileName:=StrFolder & strFile)
    For nPageNum = 1 To Selection.Information(wdNumberOfPagesInDocument)
      Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=nPageNum
      Application.Browser.Target = wdBrowsePage
      objDoc.Bookmarks("\page").Range.Select
      With objDoc.ActiveWindow
        .ActivePane.View.SeekView = wdSeekCurrentPageHeader
        With .Selection.Find
          .ClearFormatting
          .Text = strFindText
          .Replacement.ClearFormatting
          .Replacement.Text = strReplaceText
          .Wrap = wdFindContinue
          .Execute Replace:=wdReplaceAll
        End With
      End With
    Next nPageNum
    objDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    objDoc.Save
    objDoc.Close
    strFile = Dir()
  Wend
End Sub
Reply With Quote