Reading a part of a word document using VBA (including format information )

[tomjeyaraj]

I need to read part of a word document (including the format information viz Font, Size etc)

For e.g consider that the word document has the following content:

Name :
Age:
Sex:

0-0

History : uououaduaodufouadfud

Plan: dfadofuoadufoudafdfoduf

---

In the above format I want to read from 0-0 to the end of the document
and copy it to another word document using VBA

Kindly help

[Tinbendr]

Sub CopyData()
Dim aDoc As Document
Dim bDoc As Document
Dim Rng As Range
Set aDoc = ActiveDocument
'Pick your destination document setup
'Open the file
'Set bDoc = Documents.Open("C:\My documents\MyDoc.doc")
'The file is already open.
'Set bDoc = Documents("C:\My documents\mydoc.doc")
'Add a new document
Set bDoc = Documents.Add
Set Rng = aDoc.Range
Rng.Find.Execute findtext:="0-0", Wrap:=wdFindStop
If Rng.Find.Found Then
Rng.End = aDoc.Range.End
bDoc.Range.InsertAfter Rng
End If
End Sub

[fumei]

Does not copy format. Document objects not needed.
Sub OtherWay()
Dim r As Range
Set r = ActiveDocument.Range
With r.Find
.Text = "0-0"
.Execute
If .Found = True Then
r.End = ActiveDocument.Range.End
r.Copy
Documents.Add
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End If
End With
End Sub

[fumei]

Also, tonjeyaraj, you have cross posted this to Tek-Tips. There is nothing inherently "bad" about this, but it is polite to mention it when you do cross post. Please see:

http://www.excelguru.ca/node/7

[Tinbendr]

Does not copy format. Thank you Gerry!

... If Rng.Find.Found Then
Rng.End = aDoc.Range.End
bDoc.Range.FormattedText = Rng
End If
...

[fumei]

Nice one Tinbendr! An excellent solution. I like that one a lot.

[tomjeyaraj]

Thanks a lot for the help.

But the code could not copy the font/style/size information.

Any way I tried the code provided by fumei and it worked.

Again thanks a lot for the help.


Sub CopyData()
Dim aDoc As Document
Dim bDoc As Document
Dim Rng As Range
Set aDoc = ActiveDocument
'Pick your destination document setup
'Open the file
'Set bDoc = Documents.Open("C:\My documents\MyDoc.doc")
'The file is already open.
'Set bDoc = Documents("C:\My documents\mydoc.doc")
'Add a new document
Set bDoc = Documents.Add
Set Rng = aDoc.Range
Rng.Find.Execute findtext:="0-0", Wrap:=wdFindStop
If Rng.Find.Found Then
Rng.End = aDoc.Range.End
bDoc.Range.InsertAfter Rng
End If
End Sub

[tomjeyaraj]

Thanks a lot.

It worked.



Does not copy format. Document objects not needed.
Sub OtherWay()
Dim r As Range
Set r = ActiveDocument.Range
With r.Find
.Text = "0-0"
.Execute
If .Found = True Then
r.End = ActiveDocument.Range.End
r.Copy
Documents.Add
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End If
End With
End Sub

[tomjeyaraj]

Thanks again for your help with the code

I went through the url.

I felt happy that some one has thought about the efforts others put to help some body.

I felt sad that I was ignorant about it. Thank you for making me aware of the facts.



Also, tonjeyaraj, you have cross posted this to Tek-Tips. There is nothing inherently "bad" about this, but it is polite to mention it when you do cross post. Please see:

[tomjeyaraj]

Does not copy format. Document objects not needed.
Sub OtherWay()
Dim r As Range
Set r = ActiveDocument.Range
With r.Find
.Text = "0-0"
.Execute
If .Found = True Then
r.End = ActiveDocument.Range.End
r.Copy
Documents.Add
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End If
End With
End Sub


Thank you fumei

The following code given by you helps me to find a string "0-0" in a word file, and then copy the content from that point to the end of the file, to another word file.

Set r = WordDoc.Range
With r.Find
.Text = "0-0"
.Execute
If .Found = True Then

r.End = WordDoc.Range.End
r.Copy
End If
End With
Selection.PasteAndFormat (wdFormatOriginalFormatting)

Now my problem is that in some word files the string "0-0" may occur twice. In such cases, I need to locate the 2'nd occurance of the string "0-0" and copy the content from that point, to the end of the file.

Can you please give any solution for this ?

[fumei]

Please clarify. Are you saying you do NOT want to do anything with the first 0-0, but you do want to do something with the second?

Also, are you saying that sometimes there is one - and you DO want to copy forward, and sometimes there are two, and you do NOT want to copy forward from the first, but from the second?

In any case.......THINK. What would the logic be? This is not a coding issue, this is a logic issue.

Work it out. Never mind any code. The code is easy. The logic is what is important. Show me you have the logic...the code will pop out no problem.

[tomjeyaraj]

Yes I am saying sometimes there is one - and I DO want to copy forward, and sometimes there are two, and I do NOT want to copy forward from the first, but from the second

As you said I will try to sort out the problem logically.

Thanks a lot.



Please clarify. Are you saying you do NOT want to do anything with the first 0-0, but you do want to do something with the second?

Also, are you saying that sometimes there is one - and you DO want to copy forward, and sometimes there are two, and you do NOT want to copy forward from the first, but from the second?

In any case.......THINK. What would the logic be? This is not a coding issue, this is a logic issue.

Work it out. Never mind any code. The code is easy. The logic is what is important. Show me you have the logic...the code will pop out no problem.

[fumei]

First a question...and again, this is a logic issue.

Can there, will there, EVER be three (or more) "0-0". Yes or no.

If yes, then you have to build THAT into the logic.

If no, then....here is a hint.

1. Find a "0-0"
2. Mark its location.
3. Find another "0-0"
4. IF there are none, THEN use the location marker of the found "0-0"...and do your thing.

5. IF there is another, THEN...use that found location...and do your thing.

Sigh...like this:
Sub OtherWay()
Dim r As Range
Dim rStart As Long

Set r = ActiveDocument.Range
With r.Find
.Text = "0-0"
.Execute
If .Found = True Then
' mark the found location End
rStart = r.End + 1
End If
.Execute
If .Found = True Then
' this is for the second one so
' if Found…do your thing
r.End = ActiveDocument.Range.End
r.Copy
Documents.Add
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Else ' NOT found, there is no other 0-0
Set r = ActiveDocument.Range(Start:=rStart, _
End:=ActiveDocument.Range.End
r.Copy
Documents.Add
Selection.PasteAndFormat (wdFormatOriginalFormatting)

End If

End With
End Sub



Or you can use Tinbendr's FormatText. There are other ways of doing it. VBA is very flexible this way. In any case, the logic is:

Is there ONE instance of "0-0", or TWO.
If there is ONE...then do X.
If there is TWO...then do Y.

The first logical step is...finding out if there is ONE, or TWO, instances of "0-0".

[fumei]

Here is also a best practice example .Sub OtherWay()
Dim r As Range
Dim rStart As Long

Set r = ActiveDocument.Range
With r.Find
.Text = "0-0"
.Execute
If .Found = True Then
' mark the found location End
rStart = r.End + 1
End If
.Execute
If .Found = True Then
' this is for the second one so
' if Found is True…do your thing
r.End = ActiveDocument.Range.End
Call CopyStuff(r)
Else ' NOT found, there is no other 0-0
Set r = ActiveDocument.Range(Start:=rStart, _
End:=ActiveDocument.Range.End
Call CopyStuff(r)
End If

End With
End Sub

Sub CopyStuff(r As Range)
r.Copy
Documents.Add
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End Sub

You put the copying procedure (instructions) in its OWN procedure - Sub CopyStuff - and call it when you need it, passing a Range as a parameter.

This is a very good habit to get into, and will save you lots of debugging time later on if you get into longer, more complicated code.

Why?

Because the copying instructions themselves have NOTHING to do with the finding of the "0-0".

You may think they do, but from an instruction processing point-of-view, they do not.

Let's call the copying instructions "X".

If there is ONE "0-0", set a range...and do "X"

There is TWO "0-0", set a different range...and do "X".

In both cases, the actual instructions to copy ("X" - Sub CopyStuff) is precisely the same.

Therefore it can be pulled out into its own procedure, and called when needed. This tidies up the other procedure, and makes debugging easier, as an errors will be isolated in smaller procedures.