# Word Macro: loop through end of file?



## kejo (Dec 15, 2006)

hello,

how do i loop an instruction until the end of the document ?
i wasn't able to find the right way using google :\

please help


----------



## Rollin_Again (Sep 4, 2003)

Explain in detail what the macro is going to be doing.

Regards,
Rollin


----------



## kejo (Dec 15, 2006)

it's going to find a string and replace.
my macro will do it once.
i want it to find and replace all the strings in my file (until the end of file)


----------



## Rollin_Again (Sep 4, 2003)

Why not use the *wdReplaceAll * method??


```
Sub ReplaceAll()

With ActiveDocument.Content.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Execute findtext:="SearchText", replaceWith:="ReplaceText", Replace:=wdReplaceAll
End With

End Sub
```


----------



## kejo (Dec 15, 2006)

thank you Rollin_Again, but i need to learn how to loop untill End of File.
can you please tell me how to do this?


----------



## Rollin_Again (Sep 4, 2003)

You still need to explain exactly why and how you want to loop through the document. Do you want to loop through line by line and look for a certain phrase or word. Do you want to loop through word by word? You can try the code below. It looks for the built in bookmark called "EndOfDoc"


```
Sub LoopDoc()
     
Selection.HomeKey Unit:=wdStory
Selection.HomeKey Unit:=wdLine

i = 1

Do Until ActiveDocument.Bookmarks("\Sel").Range.End = _
ActiveDocument.Bookmarks("\EndOfDoc").Range.End
MsgBox ("You are on line " & i)
Selection.MoveDown
i = i + 1
Loop
     
MsgBox ("You have reached the end of the document")
     
End Sub
```
Regards,
Rollin


----------



## kejo (Dec 15, 2006)

ok thank you very much Rollin_Again, what i want to do is:
find every underlined string in the doc and make the first char of the found string red


----------



## kejo (Dec 15, 2006)

Rollin_Again said:


> You still need to explain exactly why and how you want to loop through the document. Do you want to loop through line by line and look for a certain phrase or word. Do you want to loop through word by word? You can try the code below. It looks for the built in bookmark called "EndOfDoc"
> 
> 
> ```
> ...


i am sorry to tell you that your code generates an infinite loop


----------



## Rollin_Again (Sep 4, 2003)

I modified the original code that I posted. Are you using the updated code as it appears in the post above or are you using the original code?

Regards,
Rollin


----------



## Rollin_Again (Sep 4, 2003)

Try this


```
Sub ChangeColor()

For Each vWord In ActiveDocument.Words

If vWord.Underline = 1 Then
vWord.Select
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Color = wdColorRed
End If

Next

End Sub
```
Regards,
Rollin


----------



## kejo (Dec 15, 2006)

ok your code works fine, but i need to find lines instead of words.
how to do it?
i need something like this (don't know if it exists):


```
For Each vLine In ActiveDocument.Lines
```


----------



## Rollin_Again (Sep 4, 2003)

I'm still a bit unclear on what you are trying to accomplish. Can you please provide more explanation on why you want to search line by line? Will the underlined strings you are searching for consist of more than one word?

Regards,
Rollin


----------



## kejo (Dec 15, 2006)

I have many numbered lists like this one:


```
1. [U]first item[/U]
2. second item
3. third item
```
and want to make red the number of the underlined line, like this:


```
[COLOR=Red]1[/COLOR]. [U]first item[/U]
2. second item
3. third item
```
how can i do this?
i have tried some solutions but none worked.
hope you guys are able to help me.

thanks in advance.


----------



## kejo (Dec 15, 2006)

please, anybody help, ?


----------



## Rollin_Again (Sep 4, 2003)

Can you post a sample document?

Regards,
Rollin


----------



## kejo (Dec 15, 2006)

i have attached a sample doc.


----------



## Rollin_Again (Sep 4, 2003)

There is no way to change the color of a single element in a true numbered list in MS Word. You either have to change all the number colors or not. The only way to overcome this feature in Word is to go into the AutoCorrect options and turn off the "Automatic Numbered List" option. This would however require that you recreate all the existing numbered lists. Is that an option for you? What version of MS Word are you using?

Regards,
Rollin


----------



## kejo (Dec 15, 2006)

ok i've just run this code

```
ActiveDocument.ConvertNumbersToText
```
so now i have all text.
now what to do ?


----------



## Rollin_Again (Sep 4, 2003)

Try the code below.


```
Sub ChangeColor()

ActiveDocument.ConvertNumbersToText

For Each vWord In ActiveDocument.Words

If vWord.Underline = 1 Then
vWord.Select
Selection.HomeKey Unit:=wdLine
Do Until InStr(1, Selection.Text, ".") > 0
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Loop
Selection.Font.Color = wdColorRed
End If

Next

End Sub
```
Regards,
Rollin


----------



## kejo (Dec 15, 2006)

it works but makes red some lines as well...


----------



## Rollin_Again (Sep 4, 2003)

Run the macro and attach the modified file so I can see what you are talking about.

Regards,
Rollin


----------



## kejo (Dec 15, 2006)

here is a better sample, please look at it

in a few words your code turns this:

```
1.	[U]This is a testbla blab[/U]
       [U]la bla blabla asdasd [/U]
2.	Aasdasd 
3.	Asdrttr8776
4.	Sdfdfhhfg
```
into this:


```
[COLOR="Red"]1[/COLOR].	[U]This is a testbla blab[/U]
[COLOR="Red"]       [U]la bla blabla asdasd[/U] [/COLOR]
[COLOR="Red"]2.[/COLOR]	Aasdasd 
3.	Asdrttr8776
4.	Sdfdfhhfg
```


----------



## Rollin_Again (Sep 4, 2003)

This is going to be difficult unless I have the actual document you are trying to convert since I'll need to write some special logic into the macro. Does it contain sensitive info?? Could you email it to me?

Regards,
Rollin


----------



## kejo (Dec 15, 2006)

here is a sample. 
please look at it, as it's very similar to my original doc.

thanks for understanding..


----------



## Rollin_Again (Sep 4, 2003)

Try this


```
Sub ChangeColor()

ActiveDocument.ConvertNumbersToText

For Each vWord In ActiveDocument.Words

If vWord.Underline = 1 Then
vWord.Select
Selection.HomeKey Unit:=wdLine

If IsEmpty(vStart) Then
vStart = Selection.Information(wdHorizontalPositionRelativeToPage)
End If

If Selection.Information(wdHorizontalPositionRelativeToPage) = vStart Then
Do Until InStr(1, Selection.Text, ".") > 0
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Loop
Selection.Font.Color = wdColorRed
Else
GoTo Skip
End If
End If
Skip:
Next

End Sub
```
Regards,
Rollin


----------



## slurpee55 (Oct 20, 2004)

kejo said:


> ok i've just run this code
> 
> ```
> ActiveDocument.ConvertNumbersToText
> ...


Boy, I wish I had known that last week....


----------



## Rollin_Again (Sep 4, 2003)

slurpee55 said:


> Boy, I wish I had known that last week....


Don't feel bad, I just found out about it myself 

Regards,
Rollin


----------



## kejo (Dec 15, 2006)

*Rollin* how did you learn all this stuff ??? i couldn't find it on google... 
i really don't know how to thank you ... i appreciate your help. thanks !


----------



## slurpee55 (Oct 20, 2004)

I think he channels someone....


----------



## Rollin_Again (Sep 4, 2003)

So I take it the macro worked? I pretty much taught myself VBA over the past 7 years. I started like most people and just recorded basic stuff using the macro recorder and then stepped through the generated code line by line to learn what each line did. After a while you just start to learn about all the object properties and methods. The key to becoming good at VBA is practice. I like challenges and one of the ways that I practice is by helping people like you with real world problems. 

Regards,
Rollin


----------



## kejo (Dec 15, 2006)

very nice 
you have a deep experience in this field.

your last piece of code is working like a charm:

```
Sub ChangeColor01()

ActiveDocument.ConvertNumbersToText

For Each vWord In ActiveDocument.Words

If vWord.Underline = 1 Then
    
    vWord.Select
    Selection.HomeKey Unit:=wdLine

    If IsEmpty(vStart) Then
        vStart = Selection.Information(wdHorizontalPositionRelativeToPage)
    End If

    If Selection.Information(wdHorizontalPositionRelativeToPage) = vStart Then
        Do Until InStr(1, Selection.Text, ".") > 0
        Selection.MoveRight Unit:=wdCharacter, count:=1, Extend:=wdExtend
        Loop
        Selection.Font.Color = wdColorRed
    Else
        GoTo Skip
    End If
    
End If
Skip:
Next

End Sub
```
thank you very much man.

by the way: what office version are you running?


----------



## Rollin_Again (Sep 4, 2003)

I am still running Office 2000. I have Office 2003 on disk but I am lazy and was never in a hurry to install it since the older version works fine for everything I do.

Regards,
Rollin


----------



## kejo (Dec 15, 2006)

is there a way to run this macro for all the .doc files in my folder ??


----------



## Rollin_Again (Sep 4, 2003)

Yes. Does the folder in question contain any other files other than Word files that need to be processed by the macro?

Regards,
Rollin


----------



## kejo (Dec 15, 2006)

only my docs....


----------



## Rollin_Again (Sep 4, 2003)

What version of MS Word / Office are you using??

Regards,
Rollin


----------



## kejo (Dec 15, 2006)

i am using 2003, but i have 2007 too


----------



## Rollin_Again (Sep 4, 2003)

Here is the updated code


```
Sub LoopDirectory()

Application.FileDialog(msoFileDialogFolderPicker).Show
vDirectory = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)

If Len(Dir(vDirectory & "\" & "NewFiles", vbDirectory)) = 0 Then
    MkDir vDirectory & "\" & "NewFiles"
End If

vFile = Dir(vDirectory & "\" & "*.*")

Do While vFile <> ""

    Documents.Open FileName:=vDirectory & "\" & vFile

ActiveDocument.ConvertNumbersToText

For Each vWord In ActiveDocument.Words

If vWord.Underline = 1 Then
    
    vWord.Select
    Selection.HomeKey Unit:=wdLine

    If IsEmpty(vStart) Then
        vStart = Selection.Information(wdHorizontalPositionRelativeToPage)
    End If

    If Selection.Information(wdHorizontalPositionRelativeToPage) = vStart Then
        Do Until InStr(1, Selection.Text, ".") > 0
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        Loop
        Selection.Font.Color = wdColorRed
    Else
        GoTo Skip
    End If
    
End If
Skip:
Next


ActiveDocument.SaveAs (vDirectory & "\" & "NewFiles" & "\" & ActiveDocument.Name)
ActiveDocument.Close

vFile = Dir
Loop

End Sub
```
Regards,
Rollin


----------

