We have many word docs we need to copy text from

skyslayer · #1 08-27-2014, 02:52 PM

I was tasked with this and I am not sure how to start I have been googling all day I have not found a solution I am hoping you can help.

We have many word docs we need to copy text from using a search algorithm we need to search folders and sub-folders for the specified text and copy the said text from each file to a new doc files in a different folder.

Search start:
The information received does not support the service requested:
Bla bla bla lots of text this text changes and is different in all docs from start of search to end of search this area could span multiple pages in some cases.

Search end:
The above actions are supported by the following:

The text would need to copied to a new files using the same filenames with the addition of EN to the end.
Example:
orig file name: T54916811242.doc new file name: T54916811242EN.doc

macropod · #2 08-28-2014, 02:39 AM

It's not clear from your post whether the export range includes the content at each end of the search range. It's also not clear whether you want the text (as "copy the said text" and "The text would need to copied " imply) or the formatted content.

gmayor · #3 08-28-2014, 06:32 AM

http://www.gmayor.com/document_batch_processes.htm will open every document in a folder and optionally all its sub folders and was designed with such applications in mind.

It does however require that you have some VBA knowledge to create the custom process to apply to each document, using the basic format shown on the web site. If you know what you want to do with the documents, then it should be easy enough to adapt to your requirements.

gmayor · #4 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 · #5 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 · #6 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 · #7 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 · #8 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 · #9 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 · #10 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

skyslayer · #11 08-29-2014, 12:10 PM

Update
I have discovered that the original ExtractText function somehow inserts the last table before the start
search string into the new document because I am a beginer to all this the only way for me to remove the added table or tables are to remove them
using the Sub Removetables.

My problem now is in order for my new Sub to run on the new document I need to set oNewDoc = Documents.Add(Template:=oDoc.FullName, Visible:=True)
but when it is set to true the Batch Process Documents Add-in does not work so I must do them one at a time, If I set it to False the Batch Process Documents Add-in
works with error corrupted tables as in last post but my Sub runs on the active document (the original).
I am assuming this is somthing simple but at this stage of my grasp of VBA I am at a loss.

Thank You
Jim

Code:

 
 Sub TestENV2()
ExtractTextENV2 ActiveDocument
End Sub
 Function ExtractTextENV2(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) '<---If set to True Sub Removetables works fine
            'but Batch Process Documents Add-in does not work if set to False Batch Process Documents works but Sub Removetables
            'does not work
            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)
            Call Removetables '<---new call to Sub to remove all tables in new document (by Jim)
            oNewDoc.SaveAs strNewName, addtorecentfiles:=False
            oNewDoc.Close 0
        End If
    End With
    ExtractTextENV2 = True
 lbl_Exit:
    Exit Function
Err_Handler:
    ExtractTextENV2 = False
End Function
 
 'This Sub used to remove all tables in new document
Sub Removetables()
Dim oTable As Table
Dim oNewDoc As Document
Set oNewDoc = ActiveDocument
On Error Resume Next
For Each oTable In ActiveDocument.Tables
oTable.Delete
Next oTable
End Sub

gmayor · #12 08-29-2014, 09:17 PM

You will have to include the table stripping in the main function. The following should work.

Code:

Function ExtractTextENV2(oDoc As Document) As Boolean
Dim oRng As Range
Dim oNewDoc As Document
Dim strNewName As String
Dim oTable As Table
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 And .Start > oDoc.Range.Start Then
            Set oNewDoc = Documents.Add(Template:=oDoc.FullName, Visible:=False)
            oNewDoc.Range.FormattedText = oRng.FormattedText
            For Each oTable In oNewDoc.Tables
                oTable.Delete
            Next oTable
            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
    ExtractTextENV2 = True
lbl_Exit:
    Exit Function
Err_Handler:
    ExtractTextENV2 = False
End Function

gmayor · #13 08-31-2014, 01:58 AM

Although it should not affect the processing of the last posted version, the testing threw up an issue with the reporting from the add-in that could result in a crash if the function was modified along the lines of my original response (updated below to include recent changes). I have now fixed that with an update to the add-in which you can download from my web site.

Code:

Function ExtractTextENV(oDoc As Document) As Boolean
Dim oRng As Range
Dim oNewDoc As Document
Dim strNewName As String
Dim oTable As Table
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 And .Start > oDoc.Range.Start Then
            Set oNewDoc = Documents.Add(Template:=oDoc.FullName, Visible:=False)
            oNewDoc.Range.FormattedText = oRng.FormattedText
            For Each oTable In oNewDoc.Tables
                oTable.Delete
            Next oTable
            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
        Else
            GoTo Err_Handler:
        End If
    End With
    ExtractTextENV = True
lbl_Exit:
    Exit Function
Err_Handler:
    ExtractTextENV = False
End Function

skyslayer · #14 08-31-2014, 10:45 AM

Graham
Sorry for the delay

I have used the new code and now I am getting error the Run-time error (6015:
A table in the document has become corrupted) when I run it as a macro, at code

Code:

oTable.Delete

if I place (

Code:

On Error Resume Next

) just before For

Code:

Each oTable In oNewDoc.Tables

it runs through fine and new doc looks good I also had this problem on the Sub I added in my above post do you see any problems with this or have a different solution?

I am attaching a sanitized doc because there is personnel information in the originals I hope you don't mind I run into the same issues on the sanitized doc as well by the way the bookmarks are not in all docs so I can't use this as search string.

Also I can't run your Word_Batch Process Add-in V2.2 it gives compile error (Compile error in hidden module: ModMain.
This error commonly occurs when code is incompatible with the version, platform, or architecture of this application.) I get this in word 2013 and 2010 did I install it incorrectly? I replaced the last one with the new one in the word startup folder as you state in the instructions also used the installer no difference.

Again thank you

gmayor · #15 08-31-2014, 09:31 PM

Apologies for the error - a function was inadvertently deleted whilst updating my master copy

The version on my web site has now been updated (copy attached here).

I will checkout your attachment and report back later.

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