If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Help required with Find\Replace Macro - 950 Pages document
Hello All,
I am using Office XP/Win XP. I have a 950 pages document and I am trying to run a macro for finding and replacing from a Word List Document. The list is in a two column table (about 250 rows). The macro runs and then Word hangs. How can this be rectified? Following is the macro I got from the NG: Public Sub BatchFileMultiFindReplace() 'Macro by Doug Robbins - 1st March 2004 'with additional input from Peter Hewett to replace text in all the documents in a folder 'and input from Greg Maxey to faclitate using a table for multiple find and replace words Dim myFile As String Dim PathToUse As String Dim myDoc As Document Dim rngstory As Word.Range 'Close any documents that may be open If Documents.Count 0 Then Documents.Close SaveChanges:=wdPromptToSaveChanges End If ' Get the folder containing the files With Dialogs(wdDialogCopyFile) If .Display 0 Then PathToUse = .Directory Else MsgBox "Cancelled by User" Exit Sub End If End With If Left(PathToUse, 1) = Chr(34) Then PathToUse = Mid(PathToUse, 2, Len(PathToUse) - 2) End If myFile = Dir$(PathToUse & "*.doc") While myFile "" 'Open each file and make the replacement Set myDoc = Documents.Open(PathToUse & myFile) 'Fix the skipped blank Header/Footer problem MakeHFValid 'Iterate through all story types in the current document For Each rngstory In ActiveDocument.StoryRanges 'Iterate through all linked stories Do SearchAndReplaceInStory rngstory ' Get next linked story (if any) Set rngstory = rngstory.NextStoryRange Loop Until rngstory Is Nothing Next 'Close the file, saving the changes. myDoc.Close SaveChanges:=wdSaveChanges myFile = Dir$() Wend End Sub Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range) 'This routine supplied by Peter Hewett and modified by Greg Maxey Dim Source As Document Dim i As Integer Dim Find As Range Dim Replace As Range Set Source = ActiveDocument ' Change the path and filename in the following to suit where you have your list of words Set WordList = Documents.Open(FileName:="D:\My Documents\Word Documents\Word Tips\Find and Replace List.doc") Source.Activate 'I stetted out thsi Do line because it appeard to be redundant form the main macro 'Do Until (rngstory Is Nothing) For i = 2 To WordList.Tables(1).Rows.Count Set Find = WordList.Tables(1).Cell(i, 1).Range Find.End = Find.End - 1 Set Replace = WordList.Tables(1).Cell(i, 2).Range Replace.End = Replace.End - 1 With rngstory.Find ..ClearFormatting ..Replacement.ClearFormatting ..Text = Find ..Replacement.Text = Replace ..Forward = True ..Wrap = wdFindContinue ..Format = False ..MatchCase = False ..MatchWholeWord = False ..MatchAllWordForms = False ..MatchSoundsLike = False ..MatchWildcards = False ..Execute Replace:=wdReplaceAll End With Next i 'Stetted out the follow for same reason 'Set rngstory = rngstory.NextStoryRange 'Loop End Sub Public Sub MakeHFValid() 'And this too Dim lngJunk As Long ' It does not matter whether we access the Headers or Footers property. ' The critical part is accessing the stories range object lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryT ype End Sub TIA Rashid Khan |
#2
|
|||
|
|||
Help required with Find\Replace Macro - 950 Pages document
Rashid,
I don't know what is causing the hang. Could be just your processor biting off more than it can chew. If is just a single document and the "words" are located in the main body text (i.e., not in headers, footer, etc.), you can try the following simplified macro. Also you might try breaking your list down into small chunks. Sub MultiFindAndReplace() ' Dim WordList As Document Dim Source As Document Dim i As Integer Dim Find As Range Dim Replace As Range Set Source = ActiveDocument ' Change the path and filename in the following to suit where you have your list of words Set WordList = Documents.Open(FileName:="C:\Find and Replace List.doc") Source.Activate For i = 2 To WordList.Tables(1).Rows.Count Set Find = WordList.Tables(1).Cell(i, 1).Range Find.End = Find.End - 1 Set Replace = WordList.Tables(1).Cell(i, 2).Range Replace.End = Replace.End - 1 Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = Find .Replacement.Text = Replace .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Next i End Sub -----Original Message----- Hello All, I am using Office XP/Win XP. I have a 950 pages document and I am trying to run a macro for finding and replacing from a Word List Document. The list is in a two column table (about 250 rows). The macro runs and then Word hangs. How can this be rectified? Following is the macro I got from the NG: Public Sub BatchFileMultiFindReplace() 'Macro by Doug Robbins - 1st March 2004 'with additional input from Peter Hewett to replace text in all the documents in a folder 'and input from Greg Maxey to faclitate using a table for multiple find and replace words Dim myFile As String Dim PathToUse As String Dim myDoc As Document Dim rngstory As Word.Range 'Close any documents that may be open If Documents.Count 0 Then Documents.Close SaveChanges:=wdPromptToSaveChanges End If ' Get the folder containing the files With Dialogs(wdDialogCopyFile) If .Display 0 Then PathToUse = .Directory Else MsgBox "Cancelled by User" Exit Sub End If End With If Left(PathToUse, 1) = Chr(34) Then PathToUse = Mid(PathToUse, 2, Len(PathToUse) - 2) End If myFile = Dir$(PathToUse & "*.doc") While myFile "" 'Open each file and make the replacement Set myDoc = Documents.Open(PathToUse & myFile) 'Fix the skipped blank Header/Footer problem MakeHFValid 'Iterate through all story types in the current document For Each rngstory In ActiveDocument.StoryRanges 'Iterate through all linked stories Do SearchAndReplaceInStory rngstory ' Get next linked story (if any) Set rngstory = rngstory.NextStoryRange Loop Until rngstory Is Nothing Next 'Close the file, saving the changes. myDoc.Close SaveChanges:=wdSaveChanges myFile = Dir$() Wend End Sub Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range) 'This routine supplied by Peter Hewett and modified by Greg Maxey Dim Source As Document Dim i As Integer Dim Find As Range Dim Replace As Range Set Source = ActiveDocument ' Change the path and filename in the following to suit where you have your list of words Set WordList = Documents.Open(FileName:="D:\My Documents\Word Documents\Word Tips\Find and Replace List.doc") Source.Activate 'I stetted out thsi Do line because it appeard to be redundant form the main macro 'Do Until (rngstory Is Nothing) For i = 2 To WordList.Tables(1).Rows.Count Set Find = WordList.Tables(1).Cell(i, 1).Range Find.End = Find.End - 1 Set Replace = WordList.Tables(1).Cell(i, 2).Range Replace.End = Replace.End - 1 With rngstory.Find ..ClearFormatting ..Replacement.ClearFormatting ..Text = Find ..Replacement.Text = Replace ..Forward = True ..Wrap = wdFindContinue ..Format = False ..MatchCase = False ..MatchWholeWord = False ..MatchAllWordForms = False ..MatchSoundsLike = False ..MatchWildcards = False ..Execute Replace:=wdReplaceAll End With Next i 'Stetted out the follow for same reason 'Set rngstory = rngstory.NextStoryRange 'Loop End Sub Public Sub MakeHFValid() 'And this too Dim lngJunk As Long ' It does not matter whether we access the Headers or Footers property. ' The critical part is accessing the stories range object lngJunk = ActiveDocument.Sections(1).Headers (1).Range.StoryType End Sub TIA Rashid Khan . |
#3
|
|||
|
|||
Thanks Help required with Find\Replace Macro - 950 Pages document
Hi Greg,
I have a Pentium 1.8GHz with 256 DDR, Original Intel Motherboard. Maybe this is causing the hang.. I tried your simplified macro on 950 pages document it worked to certain extent and then .... it crashed .. I tried the macro on a single page document with just four Words to be replaced... I did not break my list into small chunks.. and the macro worked fine... I will have to test it and see what is the maximum number of pages it can handle... Thanks a lot for your help and time Rashid "Greg" wrote in message ... Rashid, I don't know what is causing the hang. Could be just your processor biting off more than it can chew. If is just a single document and the "words" are located in the main body text (i.e., not in headers, footer, etc.), you can try the following simplified macro. Also you might try breaking your list down into small chunks. Sub MultiFindAndReplace() ' Dim WordList As Document Dim Source As Document Dim i As Integer Dim Find As Range Dim Replace As Range Set Source = ActiveDocument ' Change the path and filename in the following to suit where you have your list of words Set WordList = Documents.Open(FileName:="C:\Find and Replace List.doc") Source.Activate For i = 2 To WordList.Tables(1).Rows.Count Set Find = WordList.Tables(1).Cell(i, 1).Range Find.End = Find.End - 1 Set Replace = WordList.Tables(1).Cell(i, 2).Range Replace.End = Replace.End - 1 Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = Find .Replacement.Text = Replace .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Next i End Sub -----Original Message----- Hello All, I am using Office XP/Win XP. I have a 950 pages document and I am trying to run a macro for finding and replacing from a Word List Document. The list is in a two column table (about 250 rows). The macro runs and then Word hangs. How can this be rectified? Following is the macro I got from the NG: Public Sub BatchFileMultiFindReplace() 'Macro by Doug Robbins - 1st March 2004 'with additional input from Peter Hewett to replace text in all the documents in a folder 'and input from Greg Maxey to faclitate using a table for multiple find and replace words Dim myFile As String Dim PathToUse As String Dim myDoc As Document Dim rngstory As Word.Range 'Close any documents that may be open If Documents.Count 0 Then Documents.Close SaveChanges:=wdPromptToSaveChanges End If ' Get the folder containing the files With Dialogs(wdDialogCopyFile) If .Display 0 Then PathToUse = .Directory Else MsgBox "Cancelled by User" Exit Sub End If End With If Left(PathToUse, 1) = Chr(34) Then PathToUse = Mid(PathToUse, 2, Len(PathToUse) - 2) End If myFile = Dir$(PathToUse & "*.doc") While myFile "" 'Open each file and make the replacement Set myDoc = Documents.Open(PathToUse & myFile) 'Fix the skipped blank Header/Footer problem MakeHFValid 'Iterate through all story types in the current document For Each rngstory In ActiveDocument.StoryRanges 'Iterate through all linked stories Do SearchAndReplaceInStory rngstory ' Get next linked story (if any) Set rngstory = rngstory.NextStoryRange Loop Until rngstory Is Nothing Next 'Close the file, saving the changes. myDoc.Close SaveChanges:=wdSaveChanges myFile = Dir$() Wend End Sub Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range) 'This routine supplied by Peter Hewett and modified by Greg Maxey Dim Source As Document Dim i As Integer Dim Find As Range Dim Replace As Range Set Source = ActiveDocument ' Change the path and filename in the following to suit where you have your list of words Set WordList = Documents.Open(FileName:="D:\My Documents\Word Documents\Word Tips\Find and Replace List.doc") Source.Activate 'I stetted out thsi Do line because it appeard to be redundant form the main macro 'Do Until (rngstory Is Nothing) For i = 2 To WordList.Tables(1).Rows.Count Set Find = WordList.Tables(1).Cell(i, 1).Range Find.End = Find.End - 1 Set Replace = WordList.Tables(1).Cell(i, 2).Range Replace.End = Replace.End - 1 With rngstory.Find ..ClearFormatting ..Replacement.ClearFormatting ..Text = Find ..Replacement.Text = Replace ..Forward = True ..Wrap = wdFindContinue ..Format = False ..MatchCase = False ..MatchWholeWord = False ..MatchAllWordForms = False ..MatchSoundsLike = False ..MatchWildcards = False ..Execute Replace:=wdReplaceAll End With Next i 'Stetted out the follow for same reason 'Set rngstory = rngstory.NextStoryRange 'Loop End Sub Public Sub MakeHFValid() 'And this too Dim lngJunk As Long ' It does not matter whether we access the Headers or Footers property. ' The critical part is accessing the stories range object lngJunk = ActiveDocument.Sections(1).Headers (1).Range.StoryType End Sub TIA Rashid Khan . |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Number of pages in a document | saybut | General Discussion | 0 | June 16th, 2004 05:19 PM |
Cannot delete macro LookupMW | Min | New Users | 7 | June 10th, 2004 03:27 AM |
macro works on W2k pc, loses format after generating 70 pages on XP pc | Nick | Formatting Long Documents | 1 | May 13th, 2004 12:21 PM |
Using a Excel macro or VB to call up a WORD mail merge document | Bob Reynolds | Worksheet Functions | 0 | January 7th, 2004 06:25 PM |
Generate new document with data | Jon Barchenger[MS] | Worksheet Functions | 0 | November 18th, 2003 03:30 PM |