Hi

Thanks for replying but am having around 300+ find strings and 300+ replace strings and am getting errors as too many line continuations and getting expression error, can you please review once ...
Your help is highly appreicated ... thanks in advance ...


Sub UpdateDocuments()
'Note: This code requires a reference to the MS Forms 2.0 Object Library.
'See under Tools|References in the VBE. You may need to browse to and select C:\Windows\SysWOW64\FM20.DLL
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
Dim Rng As Range, i As Long, ArrFnd(), ArrRep(), RepObj As DataObject
'Insert Find & Replace expressions here. The arrays must have the same # of entries


ArrFnd = Array( _
"######", _
"Current reporting period", _
"Same period in the previous year", _
"Increase or decrease in the reporting period compared with the same period last year" , _
"At the end of the reporting period", _
"Previous year end", _
"Increase or decrease at the end of the reporting period as compared to the end of the previous year (%)", _
"Operating income (yuan)", _
"Net profit attributable to shareholders of listed company (Yuan)", _
"Net profit attributable to shareholders of listing company after deducting of non-recurring gains and losses (Yuan)", _
"Net cash flow arising from operating activity (Yuan)", _
"Basic earnings per share (yuan/share)", _
)
ArrRep = Array( _
"######", _
"Current reporting period", _
"Same period in the previous year", _
"Increase or decrease in the reporting period compared with the same period last year", _
"At the end of the reporting period", _
"Previous year end", _
"Increase or decrease at the end of the reporting period as compared to the end of the previous year (%)", _
"Operating income (yuan)", _
"Net profit attributable to shareholders of listed company (Yuan)", _
"Net profit attributable to shareholders of listing company after deducting of non-recurring gains and losses (Yuan)", _
"Net cash flow arising from operating activity (Yuan)", _
 )
strFolder = GetFolder
If strFolder = "" Then Exit Sub: Set RepObj = New DataObject
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
    AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    Set Rng = .Range
    With Rng.find
      .ClearFormatting
      With .Replacement
        .ClearFormatting
        With .Font
          .Name = "Angsana New"
          .Bold = True
          .Color = wdColorRed
        End With
      End With
      .Format = True
      .Forward = True
      .Wrap = wdFindContinue
      For i = 0 To UBound(ArrFnd)
        .Text = ArrFnd(i)
        If Len(ArrRep(i)) < 255 Then
          .Replacement.Text = ArrRep(i)
        Else
          RepObj.SetText ArrRep(i)
          RepObj.PutInClipboard
          .Replacement.Text = "^c"
        End If
        .Execute Replace:=wdReplaceAll
      Next
    End With
    .Close SaveChanges:=True
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing: Set RepObj = Nothing
Application.ScreenUpdating = True
End Sub


Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.PATH
Set oFolder = Nothing
End Function