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