Freeware Macros For Microsoft Word 2000 And VBA 6.0

This is a collection of macros which I developed for my use, which may also benefit others who wish to automate text processing tasks or learn more about how to program MS Word using Visual Basic for Applications (VBA). This resource is free for all to use, and there is no obligation, nor is permission required to copy and distribute code segments listed on this site. You may paste the code segments directly into your macro/VBA modules and modify them to suit your application. The only caveat is that I disclaim responsibility for inaccurate use resulting in problems. Since this is a free resource, technical support is not offered. However, you may send me email if you have questions about the content. If you find this site very useful and you would like to make a contribution, please click here to find out how.

This site is new and currently under construction. I expect the primary material to be complete by the end of August 2005. Thanks for visiting and happy programming!

1. Multi-Word "Find" For Large Documents.

Execute multiple "finds" in a single large document like a dictionary, copy matches to a search results document, and retain the format of the matching text.

2. Website Search From Within Word.

Launch website queries to URLs of your choice with selected text from within a Word document.

3. Links.

The MS Word Object Model (MSDN),

4. Contributions.

5. Contact Me.

1. Multi-Word "Find" For Large Documents.

Execute multiple "finds" in a single large document like a dictionary, copy matches to a search results document, and preserve the format of the matching text.

The first purpose of this macro is to enable you to effectively execute multiple "Find" commands in a large document for a list of search words, to avoid using the "find" command repeatedly in many manual steps, and to collect the matching text in a search results document. The second purpose is to retain the format of the matches found in the document. In other words, this macro will perform many Find operations in a word document using a list of search words, and retain the precise formatting of the matching text discovered during the search. The following is a summary of issues and solutions encountered during the programming phase. This explanation is followed by the VBA code, which you may paste into your application module. For an explanation of how to insert a module, and create a macro in Word, please click here.

I developed this macro for use with a foreign language dictionary, wherein each paragraph contains a word in english followed by one or more words in hindi. The dictionary is a single word document of over 700 pages. On may occasions I would look up more than 10 words manually, using the "Find" command, and thus the automation of this relatively long manual process can potentially conserve a lot of time. In the following code, you will have to make several changes to adapt it to your personal Windows environment.

Note that the program assumes the existence of a Word document on the Desktop entitled, "search results.doc." You will have to correct the path to your desktop and do one of the following: either create the search results.doc file on your desktop, or add the code to check for the existence of the file and create it automatically if not found. Alternatively, you can modify the code so that the search results are inserted at the top of the document being searched.

In its present form, the code requires that you paste or type your search list to the top of the document to be searched, in this case a dictionary entitled "english hindi dic.doc" and terminate the list with the "^" symbol. The list of search words is read into a string array SW( ) and deleted from the document (you can undo the delete after running the macro with the control-Z command "undo" command. Additional code notes follow the segment...

Sub Dictionary_Search()

Const mx = 9000

Dim SW(mx), SML(mx), SMLF(mx) As String

Dim Term, TW As String

Dim LCnt As Integer 'Number of words in search list

Dim WCnt, i, j, l, SMLCnt As Long 'Total words in the document

Dim found As Boolean

Dim doc As Document

'path to desktop: C:\Documents and Settings\Owner\Desktop

'the next paragraph of code activates the search results doc,

'or opens it if it's not open. be sure to note the paths.

For Each doc In Documents

If doc.Name = "search results.doc" Then found = True

Next doc

If found <> True Then

Documents.Open FileName:="C:\Documents and Settings\Owner\Desktop\search results.doc"

End If

Documents("english hindi dic.doc").Activate

Term = "^" 'search list terminator

LCnt = 0

WCnt = ActiveDocument.Words.count

'the next paragraph of code counts the number of words in the search list

'and adds them to the array SW( ) for use with the Find method.

For Each aword In ActiveDocument.Words

TW = Trim(LCase(aword))

If TW = Term Then Exit For

If TW < "a" Or TW > "z" Then TW = "" 'Out of range?

If Len(TW) > 0 Then

LCnt = LCnt + 1

SW(LCnt) = TW

End If

Next aword

Selection.HomeKey unit:=wdStory 'start at the beginning

System.Cursor = wdCursorWait

'selects from the beginning the first lcnt lines and the terminator to delete

'then search items so they wont be found in the search. you can put them back

'with control-z after the macro runs.

Selection.MoveDown unit:=wdLine, count:=LCnt + 1, Extend:=wdExtend

Selection.Delete unit:=wdCharacter, count:=1

For i = 1 To LCnt

Selection.Find.ClearFormatting

With Selection.Find

.Text = SW(i) 'string array SW() contains the search list

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Selection.Find.Execute

If Selection.Find.found = True Then

Selection.MoveDown unit:=wdParagraph, count:=1, Extend:=wdExtend

Selection.Copy

Documents("search results.doc").Activate

Selection.Paste

Selection.TypeParagraph

End If

Documents("english hindi dic.doc").Activate

Next i

End Sub

My code uses the Find method, and the list of search words in SW( ) to search for matches. When a match is found, the complete paragraph is selected, copied, and pasted to the search results document.

In my English-Hindi Dictionary, both the English and the Hindi text are formatted in truetype fonts (.ttf) but any combination of two or more fonts or font sizes will work with this macro. I imagine this code may be applied to searches in extensive legal documents with complex formatting, and to assist in the production of reports based on these documents.

Finally, here is a code segment to determine if the search results file exists, and to create it if not found.

Sub FileExist(SearchFile As String)

Dim FileInQuestion As String

FileInQuestion = Dir(SearchFile)

If FileInQuestion = "" Then

'create file here

Documents.Add

ActiveDocument.SaveAs ("search results.doc")

Else

'open found file here

End If

End Sub

End of Section - Return to Table of Contents.

2. Website Search From Within Word.

Launch website queries to URLs of your choice with selected text from within a Word document.

The VBA code for this macro enables the user to select text in a Word document and in a single click of a toolbar button, launch the default Internet browser, feed the selected text to the URL in its unique search string format, and retrieve the desired page of search result from that website. In the example below, I use this macro to search for book prices and availability on Amazon.com.

This code demonstrates how to temporarily convert selected text to a hyperlink, "Follow" then link by launching the browser with the given search string as a URL, and then undo the hyperlink creation, leaving the original text as before. The code can be adapted to dictionary searches, such as the free Meriam Webster dictionary, and many other applications where searches are performed frequently on a favorite website.

Sub AmazonSearch()

' customize a toolbar by adding this macro to a new button.

' 1. Click Tools, click Customize, click the Toolbars tab

' and then select the Shortcut menus item.

' 2. Expand the drop-down list on that toolbar and locate

' the one to which you want to add the command.

' 3. Next, move to the Commands tab of the Customize dialog

' box and select the Macros category and then click and

' drag the macro that you want onto the menu.

' 4. Right-click the entry and customize as desired.

Dim i, j, l, m, csc As Double

Dim s1, badr1, cs, t As String

badr1 = "http://www.amazon.com/exec/obidos/search-handle-url/ref=br_ss_hs/104-8095901-2495153?platform=gurupa&url=index%3Dstripbooks%3Arelevance-above%26dispatch%3Dsearch%26results-process%3Dbin&field-keywords="

s1 = Trim(LCase(Selection.Text))

'MsgBox Len(s1)

If Len(s1) = 1 Then End

cs = "+"

For i = 1 To Len(s1)

t = Mid$(s1, i, 1)

If t <> " " Then

cs = cs & t

Else

badr1 = badr1 & cs

cs = "+"

End If

Next i

If cs > "+" Then badr1 = badr1 & cs

ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, _

Address:=badr1 & "&Go.x=14&Go.y=11"

ActiveDocument.Hyperlinks.Item(1).Follow

ActiveDocument.Undo

ActiveDocument.Undo 'undo the selection too.

'Options.AutoFormatReplaceHyperlinks = True

'Selection.Range.r

'ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="http://amazon.com/", SubAddress:="", ScreenTip:="", TextToDisplay:=""

'AutoFormatAsYouTypeReplaceHyperlinks.

'tryit

'MsgBox r1

'here is an example keyword book search on amazon...

'http://www.amazon.com/exec/obidos/search-handle-url/ref=br_ss_hs/104-8095901-2495153?platform=gurupa&url=index%3Dstripbooks%3Arelevance-above%26dispatch%3Dsearch%26results-process%3Dbin&field-keywords=First+Principles+of+Philosophy&Go.x=14&Go.y=11

End Sub

For comparison, here is the same code adapted for the Meriam Webster Dictionary site. Note especially how the URL string must be customized for each individual website.

Sub dicsearch()

Dim i, j, l, m, csc As Double

Dim s1, badr1, cs, t As String

badr1 = "http://m-w.com/cgi-bin/dictionary?book=Dictionary&va="

s1 = Trim(LCase(Selection.Text))

If Len(s1) = 1 Then End

cs = ""

For i = 1 To Len(s1)

t = Mid$(s1, i, 1)

If t <> " " Then

cs = cs & t

Else

badr1 = badr1 & cs

cs = "&x=0&y=0"

End If

Next i

If cs > "" Then badr1 = badr1 & cs

ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, _

Address:=badr1

ActiveDocument.Hyperlinks.Item(1).Follow

ActiveDocument.Undo

'ActiveDocument.Undo 'undo the selection too.

'the google boolean search string...

'http://www.google.com/search?hl=en&lr=&q=%2Btest+%2Bwords&btnG=Search

'the arabic dictionary search string

'http://www.ectaco.co.uk/main.jsp;jsessionid=bc30eb7fda585c497ba6?do=e-services-dictionaries-word_translate1&direction=1&status=translate&lang1=23&lang2=ar&source=hummingbird

'http://m-w.com/cgi-bin/dictionary?book=Dictionary&va=pronounce&x=0&y=0

'the hindi dictionary search string

''http://www.shabdkosh.com/cpnt/option,com_enghindi/e,apricot

End Sub

End of Section - Return to Table of Contents.

Links

The Microsoft Word Complete Object Model

End of Section - Return to Table of Contents.

Contributions

The resources on this page are offered free of charge or obligation. However, if you find the resources valuable and would like to make a contribution, please consider donating a dollar to further my development. You can do this very easily using my certified Paypal account, which is:

I also appreciate contributions in the form of new ideas for useful code, corrections to existing example code, and other suggestions.

End of Section - Return to Table of Contents.

Contact

Please write to me with questions, corrections, and contributions! I welcome your input. The email address below is actually an image file, instead of text, to prevent junkmail-bots from acquiring it.

End of Section - Return to Table of Contents.