Word 2000 Looping Macro How To

R

rnewton01

Hi,

I've got a partial macro that correctly performs the beginning of what I
want but then fails. Here is what I've got:

Sub BlogEq_URL_Formatter()
'
' BlogEq_URL_Formatter Macro
' Macro recorded 1/6/2005 by .
'
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.Paste
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\[?*/"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\.?*\]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "-"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine
End Sub

It's supposed to take a list of URLs, one per line, and extract some
information from it and then put that on the next line. It does that fine,
but I need it to repeat until the end of the document.

Right now, it does the first line and then a message pops up asking me if I
want to continue searching the rest of the documnet. If I click no, the macro
stops. If I click yes, the macro finds "-" and replaces with a space.

I need the macro to somehow automatically quit finding "-" and return to the
beginning of the macro and continue on until there are no more URLs in the
document.

The URLs look like this:
[http://mydomain.com/this-page.html]
[http://mydomain.com/this-other-page.html]

And I'm trying to get:
[http://mydomain.com/this-page.html]
this page
[http://mydomain.com/this-other-page.html]
this other page

Any help is greatly appreciated.

Thanks,

Robert
 
D

Dave Lett

Hi Robert,

Using the Selection object will only you so far. I've taken your description
and come up with the following, which works on my test document:

Dim iPara As Integer
Dim oRng As Range
Dim oRngInsert As Range
Dim sText As String
'''remove empty paragraphs at end of document
Do While ActiveDocument.Paragraphs.Last.Range.Characters.Count = 1
ActiveDocument.Paragraphs.Last.Range.delete
Loop
'''loop through paragraphs
For iPara = ActiveDocument.Paragraphs.Count To 1 Step -1
Set oRng = ActiveDocument.Paragraphs(iPara).Range
With oRng
.MoveEndUntil Cset:="/", Count:=wdBackward
.Start = oRng.End
.MoveEndUntil Cset:=".", Count:=wdForward
sText = oRng.Text
End With
ActiveDocument.Paragraphs(iPara).Range.InsertParagraphAfter
Set oRngInsert = ActiveDocument.Paragraphs(iPara + 1).Range
With oRngInsert
.MoveEnd Unit:=wdCharacter, Count:=-1
.Text = oRng.Text
End With
Next iPara

HTH,
Dave

rnewton01 said:
Hi,

I've got a partial macro that correctly performs the beginning of what I
want but then fails. Here is what I've got:

Sub BlogEq_URL_Formatter()
'
' BlogEq_URL_Formatter Macro
' Macro recorded 1/6/2005 by .
'
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.Paste
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\[?*/"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\.?*\]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "-"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine
End Sub

It's supposed to take a list of URLs, one per line, and extract some
information from it and then put that on the next line. It does that fine,
but I need it to repeat until the end of the document.

Right now, it does the first line and then a message pops up asking me if I
want to continue searching the rest of the documnet. If I click no, the macro
stops. If I click yes, the macro finds "-" and replaces with a space.

I need the macro to somehow automatically quit finding "-" and return to the
beginning of the macro and continue on until there are no more URLs in the
document.

The URLs look like this:
[http://mydomain.com/this-page.html]
[http://mydomain.com/this-other-page.html]

And I'm trying to get:
[http://mydomain.com/this-page.html]
this page
[http://mydomain.com/this-other-page.html]
this other page

Any help is greatly appreciated.

Thanks,

Robert
Click to expand...
 
H

Helmut Weber

Hi Robert,

not a big problem, and a 1000 times much easier
and faster to do, if we knew more about the URLs
you are going to process.
The difficult thing is to define their structure.

Do they all end, without any exception, in ".html"?
Is the part in question therefore defined as:
The substring between the last slash "/" and ".html"?

Does the doc contain absolutely nothing but these URLs?
Not an empty paragraph anywhere?
Not even at the doc's end?

Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/
 
R

rnewton01

Hi Helmut,

The extension could be either html or htm and the url's could vary also with
domain name etc. They will always be wrapped with [] as well. Like
[http://www.domainname.com/file-name.html]

The file names will always include the dashes between words which I'm trying
to remove. So I'd want to take the file name from the end of the url, move it
to the next line, and remove the dashes, the .htm or .html extension, as well
as the ] from the end.

The url may have a directory in it like
[http://www.domainname.com/directory/file-name.htm] but it will always be
the case that the information I want to capture will be after the rightmost
forward slash "/".

The original document will have one url per line wrapped with [] and nothing
else in it, not even at the end of the list of url's.

Thanks,

Robert

P.S. I'm totally new to this stuff and what I came up with took me quite a
bit of time. So what I'm getting at is I won't understand any directions you
give unless written as to a 1st grader. :)
 
H

Helmut Weber

Hi Robert,
difficult for someone totally new,
but anway.
INPUT:
[http://mydomain.com/this-page.html]¶
[http://mydomain.com/this-other-page.html]¶
[http://mydomain.com/this-page.html]¶
[http://mydomain.com/this-other-page.html]¶
[http://mydomain.com/this-page.html]¶
OUTPUT:
[http://mydomain.com/this-page.html]¶
this page¶
[http://mydomain.com/this-other-page.html]¶
this other page¶
[http://mydomain.com/this-page.html]¶
this page¶
[http://mydomain.com/this-other-page.html]¶
this other page¶
[http://mydomain.com/this-page.html]¶
this page¶

ALGORITHM:
Sub Makro7()
ResetSearch
Dim rDcm As Range ' range of active document
Dim sTmp As String ' a temporary string
ActiveDocument.Range.InsertAfter vbCr ' just in case
' as the end of doc is something very special
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "\[*\]^013"
.MatchWildcards = True
While .Execute
If LCase(Right(rDcm.Text, 7)) = ".html]" & vbCr Or _
LCase(Right(rDcm.Text, 6)) = ".htm]" & vbCr Then
sTmp = rDcm.Text
' cut off extension
sTmp = Left(sTmp, InStr(sTmp, ".htm") - 1)
' get all after the last slash
sTmp = Right(sTmp, Len(sTmp) - InStrRev(sTmp, "/"))
sTmp = Replace(sTmp, "-", " ")
rDcm.InsertAfter sTmp & vbCr
rDcm.Collapse direction:=wdCollapseEnd
End If
Wend
End With
ResetSearch
End Sub
'---
Public Sub ResetSearch()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub

One could remove the last empty paragraph, too,
if desired.

HTH

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/
 
R

rnewton01

Hi Helmut,

Thanks very much for helping me with this.

Dumb question: What do I do with the code that you supplied? I know I need
to open up something, paste it in, and save it. But I don't know how.

Can you tell me how I should do that?

Thanks,

Robert
 
R

rnewton01

Hi Helmut,

I didn't figure out how to start a new one, but I copied over the code for
my original macro... and your VBA code worked beautifully!

Thank you very, very much!

Robert

rnewton01 said:
Hi Helmut,

Thanks very much for helping me with this.

Dumb question: What do I do with the code that you supplied? I know I need
to open up something, paste it in, and save it. But I don't know how.

Can you tell me how I should do that?

Thanks,

Robert

Helmut Weber said:
Hi Robert,
difficult for someone totally new,
but anway.
INPUT:
[http://mydomain.com/this-page.html]¶
[http://mydomain.com/this-other-page.html]¶
[http://mydomain.com/this-page.html]¶
[http://mydomain.com/this-other-page.html]¶
[http://mydomain.com/this-page.html]¶
OUTPUT:
[http://mydomain.com/this-page.html]¶
this page¶
[http://mydomain.com/this-other-page.html]¶
this other page¶
[http://mydomain.com/this-page.html]¶
this page¶
[http://mydomain.com/this-other-page.html]¶
this other page¶
[http://mydomain.com/this-page.html]¶
this page¶

ALGORITHM:
Sub Makro7()
ResetSearch
Dim rDcm As Range ' range of active document
Dim sTmp As String ' a temporary string
ActiveDocument.Range.InsertAfter vbCr ' just in case
' as the end of doc is something very special
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "\[*\]^013"
.MatchWildcards = True
While .Execute
If LCase(Right(rDcm.Text, 7)) = ".html]" & vbCr Or _
LCase(Right(rDcm.Text, 6)) = ".htm]" & vbCr Then
sTmp = rDcm.Text
' cut off extension
sTmp = Left(sTmp, InStr(sTmp, ".htm") - 1)
' get all after the last slash
sTmp = Right(sTmp, Len(sTmp) - InStrRev(sTmp, "/"))
sTmp = Replace(sTmp, "-", " ")
rDcm.InsertAfter sTmp & vbCr
rDcm.Collapse direction:=wdCollapseEnd
End If
Wend
End With
ResetSearch
End Sub
'---
Public Sub ResetSearch()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub
¶
One could remove the last empty paragraph, too,
if desired.

HTH

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Change a great number of words in word files, with a macro as short as possible. 5
Loop until end 1
Select Text to End of Footnote 9
What is needed to function probaly 2
Will not Stop 3
What am I not doing for the macro to execute 4
Word Macro for multiple searches, incl. in footnotes 2
If not found ignore 2

Top