I am having problem in using code by macropod.
[vba]Sub BulkFindReplace()
Application.ScreenUpdating = True
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
Dim xlFList As String, xlRList As String, i As Long, Rslt
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\Workbook Name.xls"
StrWkSht = "Sheet1"
If Dir(StrWkBkNm) = "" Then
MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
Exit Sub
End If
' Test whether Excel is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Excel, so we can close it later.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
End If
' Record that we've started Excel.
bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
'Hide our Excel session
If bStrt = True Then .Visible = False
For Each xlWkBk In .Workbooks
If xlWkBk.FullName = StrWkBkNm Then ' It's open
Set xlWkBk = xlWkBk
bFound = True
Exit For
End If
Next
' If not open by the current user.
If bFound = False Then
' Check if another user has it open.
If IsFileLocked(StrWkBkNm) = True Then
' Report and exit if true
MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
If bStrt = True Then .Quit
Exit Sub
End If
' The file is available, so open it.
Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
If xlWkBk Is Nothing Then
MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
If bStrt = True Then .Quit
Exit Sub
End If
End If
' Process the workbook.
With xlWkBk.Worksheets(StrWkSht)
' Find the last-used row in column A.
' Add 1 to get the next row for data-entry.
iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
' Output the captured data.
For i = 1 To iDataRow
' Skip over empty fields to preserve the underlying cell contents.
If Trim(.Range("A" & i)) <> vbNullString Then
xlFList = xlFList & "|" & Trim(.Range("A" & i))
xlRList = xlRList & "|" & Trim(.Range("B" & i))
End If
Next
End With
If bFound = False Then xlWkBk.Close False
If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Process each word from the F/R List
For i = 1 To UBound(Split(xlFList, "|"))
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindStop
.Text = Split(xlFList, "|")(i)
.Execute
'To automatically change the found text:
'• comment-out/delete the previous line and the Do While Loop
'• uncomment the next two lines
'.Replacement.Text = Split(xlRList, "|")(i)
'.Execute Replace:=wdReplaceAll
End With
'Ask the user whether to change the found text
Do While .Find.Found
.Duplicate.Select
Rslt = MsgBox("Replace this instance of:" & vbCr & _
Split(xlFList, "|")(i) & vbCr & "with:" & vbCr & _
Split(xlRList, "|")(i), vbYesNoCancel)
If Rslt = vbCancel Then Exit Sub
If Rslt = vbYes Then .Text = Split(xlRList, "|")(i)
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
Application.ScreenUpdating = True
End Sub
'
Function IsFileLocked(strFileName As String) As Boolean
On Error Resume Next
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
IsFileLocked = Err.Number
Err.Clear
End Function[/vba]
When I replace text in MS word through this Macro it replaces a some portion of Word as well. I want this should
replace the words if complete caption is found other wise it left as it is.
For more clarification please have a look at Word file (Macro Executed ,xls file also attached).
I want just complete captions should have to be replaced.
Thanks.
Reply With Quote
