-
Feb 7th, 2018, 04:49 AM
#1
Thread Starter
Hyperactive Member
[RESOLVED] find and replace in Microsoft word
HI all
please could someone help me with this bit of code below, WHICH I am find and replace text in word which works fine, but what I trying to do is search for two different find and replace.
thanks
steve
Code:
Private Sub TerminateProcess(app_exe As String)
Dim Process As Object
For Each Process In GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process Where Name = '" & app_exe & "'")
Process.Terminate
Next
End Sub
Private Sub cmdReplace_Click()
Dim appWord As Word.Application
Set appWord = CreateObject("Word.Application")
appWord.Documents.Open ("C:\TESTXX.doc")
With appWord.ActiveDocument
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = txtFind.Text
.Replacement.Text = txtReplace.Text
.Text = txtFind2.Text
.Replacement.Text = txtReplace2.Text
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
.Save
.Close
End With
Set appWord = Nothing
TerminateProcess ("WINWORD.exe")
MsgBox ("Complete")
-
Feb 7th, 2018, 07:11 AM
#2
Re: find and replace in Microsoft word
TerminateProcess ("WINWORD.exe")
this would be bad practice, a user might have several instances of word open, better just to have appword.quit
if you are not doing this from within word, selection is not a reliable valid object, even if this code is within word, if other instances of word are open you would have no way to control which document working with
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Feb 7th, 2018, 08:13 AM
#3
Thread Starter
Hyperactive Member
Re: find and replace in Microsoft word
@westcoon1
Problem is this code don't seem to work if word is already open
regards
steve
-
Feb 7th, 2018, 09:08 AM
#4
Re: find and replace in Microsoft word
Hi,
try this, open the Word doc, and open the Form from VB6
Code:
Option Explicit
Private Sub Command1_Click()
BeispielLateBinding
End Sub
Sub BeispielLateBinding()
Dim wdApp As Object 'Word.Application
Dim wdDoc As Object 'Word.Document
Dim wdRng As Object 'Word.Range
Dim wdApplLiefSchon As Boolean
Dim xEnd&
'check if Word is open
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo errorMsgWord
If wdApp Is Nothing Then
'with this you prevent Word from opening a second time
'again with Create Object
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False 'True to see what's going on
Else
wdApplLiefSchon = True
End If
Set wdDoc = wdApp.Documents.Open("C:\Testdoc.doc")
wdApp.Visible = True
Set wdRng = wdDoc.Content
wdRng.Find.ClearFormatting
wdRng.Find.Replacement.ClearFormatting
'Find
wdRng.Find.Text = Text1.Text
wdRng.Find.Replacement.Text = Text2.Text
wdRng.Find.Forward = True
wdRng.Find.Wrap = 1 'wdFindContinue
wdRng.Find.Format = False
wdRng.Find.MatchCase = False
wdRng.Find.MatchWholeWord = False
wdRng.Find.MatchWildcards = False
wdRng.Find.MatchSoundsLike = False
wdRng.Find.MatchAllWordForms = False
wdRng.Find.Execute Replace:=2 'wdReplaceAll
'---------------------
Set wdRng = Nothing 'clean up
Set wdDoc = Nothing 'clean up
Set wdApp = Nothing 'clean up
Exit Sub
errorMsgWord:
MsgBox Err.Description, 16, "Error"
On Error Resume Next
Set wdDoc = Nothing
Set wdApp = Nothing
Set wdRng = Nothing
End Sub
regards
Chris
to hunt a species to extinction is not logical !
since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.
-
Feb 7th, 2018, 11:04 AM
#5
Re: find and replace in Microsoft word
Well gosh, you could always just shut the user's machine down. Maybe after removing a few important files or posting a ransom request?
-
Feb 7th, 2018, 11:58 AM
#6
Thread Starter
Hyperactive Member
Re: find and replace in Microsoft word
@ChrisE
Thank you for that code, how can I change it so it finds and replaces two separate lines in one doc file then save close all in the background thanks
Regards
Steve
-
Feb 7th, 2018, 01:49 PM
#7
Re: find and replace in Microsoft word
Hi,
not sure what the problem is ?
you have Text1(Find)
you have Text2(Replace)
enter what you want more than once.
if you don't want to see the .Doc then set it to Visible=False
Code:
Set wdDoc = wdApp.Documents.Open("C:\Testdoc.doc")
wdApp.Visible = False
regards
Chris
to hunt a species to extinction is not logical !
since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.
-
Feb 7th, 2018, 04:24 PM
#8
Thread Starter
Hyperactive Member
Re: find and replace in Microsoft word
@ChrisE
the textbox's will be pre filled with text I want it to change the word document automated I will properly move the code to a timer so I can tell it when to run so there be no user doing anything, so want it to load word doc, find and replace then save and close word running In background.
the reason I want it to do two find and replace is that I need two areas of the document changed at the same time. hope this help what I am trying to do.
regards
steve
-
Feb 8th, 2018, 02:52 AM
#9
Re: find and replace in Microsoft word
Hi Steve
just add a second block to Find-Replace
Code:
Private Sub Command1_Click()
BeispielLateBinding
End Sub
Sub BeispielLateBinding()
Dim wdApp As Object 'Word.Application
Dim wdDoc As Object 'Word.Document
Dim wdRng As Object 'Word.Range
Dim wdApplLiefSchon As Boolean
Dim xEnd&
'check if Word is open
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo errorMsgWord
If wdApp Is Nothing Then
'with this you prevent Word from opening a second time
'again with Create Object
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False 'True to see what's going on
Else
wdApplLiefSchon = True
End If
Set wdDoc = wdApp.Documents.Open("C:\Testdoc.doc")
wdApp.Visible = False
Set wdRng = wdDoc.Content
wdRng.Find.ClearFormatting
wdRng.Find.Replacement.ClearFormatting
'Find 1:
wdRng.Find.Text = Text1
wdRng.Find.Replacement.Text = Text2.Text
wdRng.Find.Forward = True
wdRng.Find.Wrap = 1 'wdFindContinue
wdRng.Find.Format = False
wdRng.Find.MatchCase = False
wdRng.Find.MatchWholeWord = False
wdRng.Find.MatchWildcards = False
wdRng.Find.MatchSoundsLike = False
wdRng.Find.MatchAllWordForms = False
wdRng.Find.Execute Replace:=2 'wdReplaceAll
' 'Find 2:
wdRng.Find.Text = Text3.Text
wdRng.Find.Replacement.Text = Text4.Text
wdRng.Find.Forward = True
wdRng.Find.Wrap = 1 'wdFindContinue
wdRng.Find.Format = False
wdRng.Find.MatchCase = False
wdRng.Find.MatchWholeWord = False
wdRng.Find.MatchWildcards = False
wdRng.Find.MatchSoundsLike = False
wdRng.Find.MatchAllWordForms = False
wdRng.Find.Execute Replace:=2 'wdReplaceAll
wdDoc.Close SaveChanges:=True
'---------------------
Set wdRng = Nothing 'Am ende nie vergessen
Set wdDoc = Nothing 'Am ende nie vergessen
Set wdApp = Nothing 'Am ende nie vergessen
Exit Sub
errorMsgWord:
MsgBox Err.Description, 16, "Error"
On Error Resume Next
Set wdDoc = Nothing
Set wdApp = Nothing
Set wdRng = Nothing
End Sub
or use Split ...
Code:
Private Sub Command1_Click()
BeispielLateBinding
End Sub
Sub BeispielLateBinding()
Dim wdApp As Object 'Word.Application
Dim wdDoc As Object 'Word.Document
Dim wdRng As Object 'Word.Range
Dim wdApplLiefSchon As Boolean
Dim xEnd&
Dim strFind As String, strReplace As String
Dim i As Long
strFind = Text1.Text & "," & Text3.Text
strReplace = Text2.Text & "," & Text4.Text
'check if Word is open
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo errorMsgWord
If wdApp Is Nothing Then
'with this you prevent Word from opening a second time
'again with Create Object
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False 'True to see what's going on
Else
wdApplLiefSchon = True
End If
Set wdDoc = wdApp.Documents.Open("C:\Testdoc.doc")
wdApp.Visible = False
Set wdRng = wdDoc.Content
wdRng.Find.ClearFormatting
wdRng.Find.Replacement.ClearFormatting
'Find:
For i = 0 To UBound(Split(strFind, ","))
wdRng.Find.Text = Split(strFind, ",")(i)
wdRng.Find.Replacement.Text = Split(strReplace, ",")(i)
wdRng.Find.Forward = True
wdRng.Find.Wrap = 1 'wdFindContinue
wdRng.Find.Format = False
wdRng.Find.MatchCase = False
wdRng.Find.MatchWholeWord = False
wdRng.Find.MatchWildcards = False
wdRng.Find.MatchSoundsLike = False
wdRng.Find.MatchAllWordForms = False
wdRng.Find.Execute Replace:=2 'wdReplaceAll
Next i
wdDoc.Close SaveChanges:=True
'---------------------
Set wdRng = Nothing 'Am ende nie vergessen
Set wdDoc = Nothing 'Am ende nie vergessen
Set wdApp = Nothing 'Am ende nie vergessen
Exit Sub
errorMsgWord:
MsgBox Err.Description, 16, "Error"
On Error Resume Next
Set wdDoc = Nothing
Set wdApp = Nothing
Set wdRng = Nothing
End Sub
don't know what you prefer
regards
Chris
Last edited by ChrisE; Feb 8th, 2018 at 03:45 AM.
to hunt a species to extinction is not logical !
since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.
-
Feb 10th, 2018, 11:58 AM
#10
Thread Starter
Hyperactive Member
Re: find and replace in Microsoft word
@ChrisE
Thank you for your help, works great
Just a thought is there away in the code to make it save has a PDF file?
Regards
Steve
Last edited by sbarber007; Feb 10th, 2018 at 12:39 PM.
-
Feb 10th, 2018, 01:47 PM
#11
Re: [RESOLVED] find and replace in Microsoft word
Hi,
you could Install the PDF-Creator (it's Free for Download), once Installed make sure it is set to the default printer.
that's it more or less.
regards
Chris
to hunt a species to extinction is not logical !
since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.
-
Feb 10th, 2018, 08:14 PM
#12
Re: [RESOLVED] find and replace in Microsoft word
Just a thought is there away in the code to make it save has a PDF file?
later versions of office can saveAs to a pdf, you need to specify the filetype and matching extension in the path
Code:
wdDoc.saveAs "c:\temp\mypdf.pdf", wdformatpdf
wdformatpdf = 17
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|