#1
|
|||
|
|||
Highlight word document with words from .txt file
Hi Everyone,
I would like help in a script I have. This script is meant to highlight words based off a local .txt file. The word document I use has anywhere between 100-300 pages I find the following script appears to not highlight the entire word and takes a long time to execute. An example of the .txt document would be Quote:
Is there any improvements to this script that can be performed? For increased running time and how it actually works Code:
Sub NewWordReplacement1() Dim sCheckDoc As String Dim docRef As Document Dim docCurrent As Document Dim wrdRef As Object sCheckDoc = "C:\Folder\Textfile.txt" Set docCurrent = Selection.Document Set docRef = Documents.Open(sCheckDoc) docCurrent.Activate Options.DefaultHighlightColorIndex = wdRed With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Replacement.Font.Bold = True .Forward = True .Format = True .MatchWholeWord = True .MatchCase = True .MatchWildcards = False End With For Each wrdRef In docRef.Words If Asc(Left(wrdRef, 1)) > 32 Then With Selection.Find .Wrap = wdFindContinue .Text = wrdRef .Execute Replace:=wdReplaceAll .Replacement.Highlight = True End With End If Next wrdRef docRef.Close docCurrent.Activate End Sub |
#2
|
||||
|
||||
There are two obvious ways to speed up your code.
1. Avoid the selection object to reduce the need for screen scrolling 2. Search each phrase (URL) instead of each word since google.com.au is three separate words and it really should be done as a single find/replace Code:
Sub NewWordReplacement2() Dim sCheckDoc As String Dim docRef As Document, docCurrent As Document Dim i As Integer, arrFind() As String, sFind As String sCheckDoc = "C:\Folder\Textfile.txt" Set docCurrent = ActiveDocument Set docRef = Documents.Open(sCheckDoc) arrFind = Split(docRef.Range.Text, vbCrLf) docRef.Close Options.DefaultHighlightColorIndex = wdRed With docCurrent.Range.Find .ClearFormatting .Replacement.ClearFormatting .Replacement.Font.Bold = True .Replacement.Highlight = True .Forward = True .Wrap = wdFindContinue .Format = True .MatchWholeWord = False .MatchCase = True .MatchWildcards = False For i = LBound(arrFind) To UBound(arrFind) sFind = Trim(arrFind(i)) If Len(sFind) > 1 Then .Text = sFind .Execute Replace:=wdReplaceAll End If Next i End With End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
||||
|
||||
There's a third way - and that's to read the text file directly to an array without opening it e.g. Using Andrew's code as an example.
Code:
Sub ReplacefromTXT() 'Graham Mayor - https://www.gmayor.com - Last updated - 19 Jan 2023 Dim FSO As Object, oFile As Object Dim arrFind() As String, sFind As String Dim oDoc As Document Dim i As Integer Const sName As String = "C:\Test\Test.txt" ' change this to your text file full name Set FSO = CreateObject("Scripting.FileSystemObject") Set oFile = FSO.OpenTextFile(sName, 1) arrFind = Split(oFile.ReadAll, vbNewLine) Set oDoc = ActiveDocument Options.DefaultHighlightColorIndex = wdRed With oDoc.Range.Find .ClearFormatting .Replacement.ClearFormatting .Replacement.Font.Bold = True .Replacement.Highlight = True .Forward = True .Wrap = wdFindContinue .Format = True .MatchWholeWord = False .MatchCase = True .MatchWildcards = False For i = LBound(arrFind) To UBound(arrFind) sFind = Trim(arrFind(i)) If Len(sFind) > 1 Then .Text = sFind .Execute Replace:=wdReplaceAll End If Next i End With lbl_Exit: Set FSO = Nothing Set oFile = Nothing Set oDoc = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#4
|
|||
|
|||
I have tried both of those but I am now getting the error
vbaerror.png I am assuming I need to limit the size of whatever text .Text finds |
#5
|
||||
|
||||
It would most likely be due to that. The sample you provided only had short URLs so we didn't anticipate much longer strings.
I assume the text file isn't changed often so it would be easier to edit that to split any of overly long lines by adding a paragraph mark in a logical location than it would be to add complexity to the vba code. I would expect the maximum string length to be something around a power of 2 eg 64, 128 or 256 characters. You can hover your mouse over the Len(sFind) to see how big the unacceptable number is.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#6
|
|||
|
|||
Quote:
Thanks for this, I just changed the script (That generates the .txt document) to cull links over 256 I've got one more question, it seems that the VBA macro will highlight any words separated by spaces. Is there a way to instead find and replace by the whole word? For example if I had the word "Google Account Services" in the .txt document instead of Google, Account and Services being highlighted I only wanted occurrences of the entire word. |
#7
|
||||
|
||||
Looking at the code both Graham and I provided looks like PHRASES like "Google Account Services" would not find "Google", "Account" or "Services" unless they are together. Perhaps you need to provide a sample txt file that is not working for you so we can see what the problem might be.
The MatchWholeWord setting is irrelevant if the find string includes spaces as you describe.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#8
|
|||
|
|||
Quote:
I've rerun the script that generates the .txt file and again I am getting the "String Parameter too long" error List of words from the .txt file
Screenshot 2023-01-24 091434.png |
#9
|
||||
|
||||
You need to look at the invisible characters in your text file.
sFind = "Ampac implies that following the word Ampac is something else, like a new line rather than " Warranty". I would expect it to be showing sFind = "Ampac Warranty" You can add a Watch to the sFind variable to monitor its value is while the macro is running. The macro assumes that the search terms are separated by a vbCrLf which translates to a Carriage Return/Line Feed in a text file. If your text file contents is structured differently to what the macro assumes then the code will need to be adjusted to correctly deal with the ACTUAL contents of the text file rather than the assumed contents.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#10
|
|||
|
|||
Quote:
This is an example of what the .txt document looks like Screenshot 2023-01-24 102823.png I've tried to add extra spaces to the end and new lines between the phrases but this did not work |
#11
|
||||
|
||||
Your example appears to show a table, or line numbering, neither of which are compatible with a text file. For the process to work (certainly the version I posted) each line should only contain the search string e.g.
Ampac Warranty Hochiki Warranty Panasonic Warranty HP Warranty Sony Warranty LG Warranty
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#12
|
||||
|
||||
Attach a sample text file so we can do some testing to see what is going on.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Find and highlight multiple words in MS Word document | AtaLoss | Word VBA | 37 | 09-22-2021 12:04 PM |
Macro To Identify & Highlight Words In MS Word Based Upon A List In Excel File Column | abhimanyu | Word VBA | 5 | 03-20-2020 01:33 PM |
How to find (highlight) two and more words in a list of 75k single words in Word 2010 | Usora | Word | 8 | 05-29-2018 03:34 AM |
Find and highlight multiple words in MS Word document | qkjack | Word VBA | 7 | 02-21-2018 07:09 PM |
Macro to highlight repeated words in word file and extract into excel file | aabri | Word VBA | 1 | 06-14-2015 07:20 AM |