We have many word docs we need to copy text from

gmayor · #1 08-28-2014, 07:38 AM

Having re-read the question, I think there is enough information to suggest a function. Open a document with the required text and test with the following to see if it gives you the results you want:

Code:

Sub Test()
ExtractText ActiveDocument
End Sub

If it does then run it as a custom process from the aforementioned add-in

Try it on a small group of three or four files first. The function puts the files in the same folder as the documents, but you can change the path if you wish.

Code:

Function ExtractText(oDoc As Document) As Boolean
Dim oRng As Range
Dim oNewRange As Range
Dim oNewDoc As Document
Dim strNewName As String
Const strStart As String = "The information received does not support the service requested:"
Const strEnd As String = "The above actions are supported by the following:"
    On Error GoTo Err_Handler
    Set oRng = oDoc.Range
    With oRng
        .Start = .Start + InStr(oRng, strStart) - 1
        .End = .Start + InStr(oRng, strEnd) - 1
        If Len(.Text) > 0 Then
            Set oNewDoc = Documents.Add(Template:=oDoc.FullName, Visible:=False)
            oNewDoc.Range.FormattedText = oRng.FormattedText
            Set oNewRange = oNewDoc.Range
            oNewRange.Collapse wdCollapseStart
            oNewRange.MoveEndUntil ":"
            oNewRange.End = oNewRange.End + 2
            oNewRange.Delete
            strNewName = oDoc.FullName
            strNewName = Left(strNewName, InStrRev(strNewName, Chr(46)) - 1)
            strNewName = strNewName & "EN"
            strNewName = strNewName & Right(oDoc.name, Len(oDoc.name) - InStrRev(oDoc.name, Chr(46)) + 1)
            oNewDoc.SaveAs strNewName, addtorecentfiles:=False
            oNewDoc.Close 0
        End If
    End With
    ExtractText = True

lbl_Exit:
    Exit Function
Err_Handler:
    ExtractText = False
End Function

skyslayer · #2 08-28-2014, 08:59 AM

Paul and Graham first I would like to thank you for helping me

Paul to answer your questions
I would like to include the continent at each end of the search range.
If possible I would like to keep the formatting within the search range including the search strings or be able to place the text into a pre-formatted area of the new docs

Graham I will give your recommendation a shot and report back

Thank again

Jim

skyslayer · #3 08-28-2014, 12:15 PM

Graham
Thank you I almost have it going your function looks like it extracts the data.

My hurdle to overcome is the function will not auto save the extracted source it creates a new Document1 that is hidden I can only see it being created because I am in the VBA screen, when I log-off the computer word will ask me if I want to save the Document1 it will allow me save the file and the file contains the extracted data as needed less the search strings. I have used the script on Word 2013, 2010 with same result when I debug (step-into) it will make many new Documents. I do not get any errors during the macro run do you have any ideas?

skyslayer · #4 08-28-2014, 12:47 PM

Update

I temporly set

Code:

Set oNewDoc = Documents.Add(Template:=oDoc.FullName, Visible:=True)

now I can see the doc.

When I step into the code and run the

Code:

oNewRange.Delete

it jumps to

Code:

lbl_Exit:
    Exit Function

If I skip

Code:

oNewRange.Delete

the new file is created with correct name but not saved until I exit word any ideas?

Thanks Jim

skyslayer · #5 08-28-2014, 01:59 PM

I hit another snag

It looks like all the copied data is good until the end on all the files the last nine characters are missing.

It happens when I run

Code:

oNewDoc.Range.FormattedText = oRng.FormattedText

also is there a way to copy the search string as well to the new doc?

At this stage I am still skipping

Code:

oNewRange.Delete

Thanks Jim

gmayor · #6 08-28-2014, 09:16 PM

If you want to keep the start and end search strings, you don't need any of the oNewRange lines. The reason for the skipping is presumably because you are testing with an unsaved document, so the naming section errors out and when that occurs it moves to the label. If that is not it, comment out the On Error line (while testing with the test macro) and see which line causes the error. It works here when tested in Word 2010 and 2013.

Code:

Function ExtractText(oDoc As Document) As Boolean
Dim oRng As Range
Dim oNewDoc As Document
Dim strNewName As String
Const strStart As String = "The information received does not support the service requested:"
Const strEnd As String = "The above actions are supported by the following:"
    On Error GoTo Err_Handler
    Set oRng = oDoc.Range
    With oRng
        .Start = .Start + InStr(oRng, strStart) - 1 
        .End = .Start + InStr(oRng, strEnd) + 1
        .MoveEndUntil Chr(58)
        .End = .End + 1
        If Len(.Text) > 0 Then
            Set oNewDoc = Documents.Add(Template:=oDoc.FullName, Visible:=True)
            oNewDoc.Range.FormattedText = oRng.FormattedText
            strNewName = oDoc.FullName
            strNewName = Left(strNewName, InStrRev(strNewName, Chr(46)) - 1)
            strNewName = strNewName & "EN"
            strNewName = strNewName & Right(oDoc.name, Len(oDoc.name) - InStrRev(oDoc.name, Chr(46)) + 1)
            oNewDoc.SaveAs strNewName, addtorecentfiles:=False
            oNewDoc.Close 0
        End If
    End With
    ExtractText = True

lbl_Exit:
    Exit Function
Err_Handler:
    ExtractText = False
End Function

skyslayer · #7 08-29-2014, 07:34 AM

Graham
You are the man!

thank you again

I still have one problem
all is well until I get to the end at

Code:

oNewDoc.SaveAs strNewName, addtorecentfiles:=False

if I comment out On Error that line of code spits out this error code
Run-time error 6015:
A table in the document has become corrupted.
There are tables in the doc and they are not needed in the new doc they are before and after search strings

the result is the new document or documents will not close, if I keep going in the code all looks good in the new doc except for a empty table that could go away it is not needed.

I am looking for solutions on-line as well

Again thanks Jim

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Copy Text Twice to Paste into word	Albundy	Word	2	09-02-2016 12:59 PM
Text Shifting When Saving Word 2007 Docs	DerekS	Word	1	09-21-2013 02:42 AM
Can't copy/cut and paste text in Word 2002	mmiller751	Word	0	04-17-2012 02:55 PM
copy from word into a formatting text box	mikewooten	Word	1	06-15-2010 02:04 AM
Is it possible to create 'balloon' text in docs	bubbleboi	Word	3	11-13-2009 01:19 AM