Macro: search and transfer text strings from Word to Excel

  • Thread starter mindful_learner
  • Start date
M

mindful_learner

Hi everyone,


Apologies in advance if this is the wrong forum for this question.


I need a simple macro to search for certain text strings in a document
and then copy these instances into an Excel document. I'm presuming
this is a rather simple task to do. I don't have time to learn VBA to
do this one-off task and I wondered if anyone had some code I could
steal/modify. Grateful thanks in advance if anyone can be so kind to
help.


Here's what I need in more detail:


I have a word document which contains text organised around headings.
For example:


Page 1
Text: a text string
Graphic: a graphic name.


I want a macro that will search for all instances of the word 'Graphic'

and then copy the text string that comes after this, which then needs
to be put in an Excel sheet. The word 'Graphic' and the following text

string is always in a table row. The text string after the word
'Graphic' always ends in a full stop. The word Graphic is always
followed by a colon.


Added complication! Sometimes the word graphic is 'Graphic_1:' or
'Graphic_2:' etc, so the initial search would have to be something like

SEARCH FOR 'Graphic*:' (i.e. use * as a wildcard character).


It would be nice if the final excel sheet could group found entries by
the page they were found on Word. E.g. if the Word document had this:


Page 1
Graphic_1: cat
Graphic_2: dog


Page 2
Graphic_1: apple
Graphic_2: pear


The final Excel sheet would have a Graphic column with


cat
dog
---- space----
apple
pear


I know this is a lot to ask, but you'd really be saving me a ton of
time. I just don't have time to start learning macro programming for
this single-task. If anyone can give me anything to get me started it
would be much appreciated. I have programmed in C and C++ before, so I

can understand any general programming instructions you need to give
me.


Kind regards
 
M

mindful_learner

Hi Helmut,

The word 'Graphic' and the following text string are always in one (1)
cell. The delimiter between the two words is the colon :)) after the
word 'Graphic'. To summarise, I'd need some kinda algorithm like the
following (excuse the appaling pseudo code - i just want to get the
point across).

For (the whole document/each page)
Find each instance of text string 'Graphic*:'
Copy text after colon :)) until full stop (or end of table row)
Paste text string into new Excel cell in Column 'A'
Enter blank row into Excel each time new page is encountered
End For

There! Terrible algorithm, but hopefully gets the point across ;0)

Many thanks,
mindful
 
H

Helmut Weber

Hi,
I think a lot at once is rarely a good idea. ;-)
1st, to get the strings to be transferred to Excel:

Sub test783()
Dim rTmp As Range
Dim s As String ' String for excel
Set rTmp = ActiveDocument.Range
ResetSearch
With rTmp.Find
.Text = "Graphic*:"
.MatchCase = True
.MatchWildcards = True
While .Execute
rTmp.Collapse direction:=wdCollapseEnd
.Text = "*."
.Execute
s = Trim(rTmp.Text)
' to get rid of leading and trailing spaces
s = Left(s, Len(s) - 1)
' to get rid of the trailing full stop
MsgBox "transfer to Excel: " & s
rTmp.Collapse direction:=wdCollapseEnd
rTmp.End = ActiveDocument.Range.End
.Text = "Graphic*:"
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
' plus some more if needed
.Execute
End With
End Sub

Then you would need something which tells you,
whether you are on a new page.
OK, start with page 1, the initial value.
Check whether rTmp.Information(wdActiveEndPageNumber)
is equal to initial value. If so, you are on the same page,
if not you are on a new page. Then set the inital value to
the new page.

Sub test784()
Dim rTmp As Range
Dim lPg1 As Long
Dim lPgx As Long
Set rTmp = ActiveDocument.Range
lPg1 = 1
ResetSearch
With rTmp.Find
.Text = "the"
While .Execute
lPgx = rTmp.Information(wdActiveEndPageNumber)
If lPgx <> lPg1 Then
MsgBox "Old page = " & lPg1 & " New Page = " & lPgx
lPg1 = lPgx
End If
Wend
End With
ResetSearch
End Sub

Of course, in no way all you want.
But I'd say, try to get comfortable with that at first,
and then ask again.
Without learning some VBA it'll be hard.

Greetings from Bavaria, Germany

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

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

Top