[RESOLVED] find and replace in Microsoft word-VBForums
Results 1 to 12 of 12

Thread: [RESOLVED] find and replace in Microsoft word

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Jul 2012
    Location
    Essex
    Posts
    246

    Resolved [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")

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    23,261

    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

  3. #3

    Thread Starter
    Addicted Member
    Join Date
    Jul 2012
    Location
    Essex
    Posts
    246

    Re: find and replace in Microsoft word

    @westcoon1

    Problem is this code don't seem to work if word is already open

    regards
    steve

  4. #4
    Fanatic Member ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    953

    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.

  5. #5
    PowerPoster
    Join Date
    Feb 2006
    Posts
    18,270

    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?

  6. #6

    Thread Starter
    Addicted Member
    Join Date
    Jul 2012
    Location
    Essex
    Posts
    246

    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

  7. #7
    Fanatic Member ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    953

    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.

  8. #8

    Thread Starter
    Addicted Member
    Join Date
    Jul 2012
    Location
    Essex
    Posts
    246

    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

  9. #9
    Fanatic Member ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    953

    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.

  10. #10

    Thread Starter
    Addicted Member
    Join Date
    Jul 2012
    Location
    Essex
    Posts
    246

    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.

  11. #11
    Fanatic Member ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    953

    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.

  12. #12
    PowerPoster
    Join Date
    Dec 2004
    Posts
    23,261

    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
  •  



Featured


Click Here to Expand Forum to Full Width