Hi,
Im have been using below to update word docs, after modifying it to update an open word document rather than pointing to specific document anyone able to assist with conversion.
--------------------------------------------------------
Sub FindReplaceInWord()
Dim Wbk As Workbook: Set Wbk = ThisWorkbook
Dim Wrd As New Word.Application
Dim Dict As Object
Dim RefList As Range, RefElem As Range
Wrd.Visible = True
Dim WDoc As Document
Set WDoc = Wrd.Documents.Open("file path") 'Modify as necessary.
Set Dict = CreateObject("Scripting.Dictionary")
Set RefList = Wbk.Sheets("Sheet1").Range("C2:C16") 'Modify as necessary.
With Dict
For Each RefElem In RefList
If Not .Exists(RefElem) And Not IsEmpty(RefElem) Then
.Add RefElem.Value, RefElem.Offset(0, 1).Value
End If
Next RefElem
End With
For Each Key In Dict
With WDoc.Content.Find
If Dict(Key) = "" Then
.Execute FindText:=Key & "^p", ReplaceWith:=Dict(Key)
Else
.Execute FindText:=Key, ReplaceWith:=Dict(Key)
End If
End With
Next Key
--------------------------------------------------------
I have tried adding in........
Dim wdApp As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0
If wdApp Is Nothing Then
MsgBox "No instances of Word found"
Exit Sub
End If
Always end up with run time error 424 at line "WDoc.Content.Find"
Any help always appreciated.
Im have been using below to update word docs, after modifying it to update an open word document rather than pointing to specific document anyone able to assist with conversion.
--------------------------------------------------------
Sub FindReplaceInWord()
Dim Wbk As Workbook: Set Wbk = ThisWorkbook
Dim Wrd As New Word.Application
Dim Dict As Object
Dim RefList As Range, RefElem As Range
Wrd.Visible = True
Dim WDoc As Document
Set WDoc = Wrd.Documents.Open("file path") 'Modify as necessary.
Set Dict = CreateObject("Scripting.Dictionary")
Set RefList = Wbk.Sheets("Sheet1").Range("C2:C16") 'Modify as necessary.
With Dict
For Each RefElem In RefList
If Not .Exists(RefElem) And Not IsEmpty(RefElem) Then
.Add RefElem.Value, RefElem.Offset(0, 1).Value
End If
Next RefElem
End With
For Each Key In Dict
With WDoc.Content.Find
If Dict(Key) = "" Then
.Execute FindText:=Key & "^p", ReplaceWith:=Dict(Key)
Else
.Execute FindText:=Key, ReplaceWith:=Dict(Key)
End If
End With
Next Key
--------------------------------------------------------
I have tried adding in........
Dim wdApp As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0
If wdApp Is Nothing Then
MsgBox "No instances of Word found"
Exit Sub
End If
Always end up with run time error 424 at line "WDoc.Content.Find"
Any help always appreciated.
