Microsoft Office Forums - View Single Post - [Solved] We have many word docs we need to copy text from

gmayor · 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