[RESOLVED] Trying to get part of a word document into a variable

[Elroy]

Yes, it's always nice when people post their working resolution.

[el84]

This morning I'd like to zero in on one requirement, to fit into my existing code. I have a document with two JPGs in followed by some words, one of which is "AND". I want to delete everything up to "AND" (jpgs and text), using a *simple* method that fits with the existing code if possible. At the moment it is

Set myRange = ActiveDocument.Range(0, 0)
        myRange.Delete

and then save of course

At present this appears to delete just the first JPG. I suspect that there may be a simple way of specifying the actual word that will form the end of the deleted block. With my tunnel thinking handicap I need it to be kept simple and fit in with what I have, if that is possible.

[Elroy]

Hi el84,

Just off the top of my head, you could search for "AND", and then go back to the top of the document using the wdExtend option.

Just looking at my post #37, you could modify this line ...

DocText.HomeKey wdStory, wdMove

... to look like this ...

DocText.HomeKey wdStory, wdExtend

... and that would take you, from wherever you are in the document, back to the top, selecting everything between.

It seems like that'd get it done. And then, of course, deleting.

Good Luck,
Elroy

[el84]

I have persevered with my own code and boiled it down to establishing the range that should be deleted from outDoc before copying in the InDoc.

The following is working well, with the sole exception that it is placing an extra linefeed in the modified outDoc, after AND.

**EDIT** Now fixed; see EDITs in code (two lines changed)

***I'll be happy if anyone sees errors or unnecessary lines in that. EDITED TYPO (lies!)

Private Sub cmdDoIt_Click()
        Set inDoc = wrdApp.Documents.Open(docPath & "aaTest" & "\aTestIn.docx")
        inDoc.ActiveWindow.ActivePane.Selection.WholeStory
        inDoc.ActiveWindow.ActivePane.Selection.Copy
                        
        'open outDoc
        Set outDoc = wrdApp.Documents.Open(docPath & "aaTest" & "\aTestOut.docx")
        
        'find position of AND in OutDoc
        Dim EndPos As Integer
        Set getAnd = ActiveDocument.Range
        getAnd.Find.Execute FindText:="AND"
        EndPos = getAnd.Start
        EndPos = EndPos + 4  'EDIT changed this since posted
                
        'delete the range up to and including AND
        Set myRange = ActiveDocument.Range(0, EndPos)  'EDIT changed this since posted
        myRange.Delete
        
        'now paste in the whole of inDoc (goes to top of document by default)
        outDoc.ActiveWindow.ActivePane.Selection.Paste
        
        'and save and leave
        wrdApp.Quit SaveChanges:=wdSaveChanges
                
        'release memory and close form
        Set wrdApp = Nothing
        Set inDoc = Nothing
        Set outDoc = Nothing
        Set getAnd = Nothing
        Set myRange = Nothing
        Unload Me
End Sub

[Elroy]

I didn't test anything, but it looks good to me.

I like your use of the Range object. My primary use of Word automation is using Word documents as report templates. Basically, I have "fields" defined in the templates, and then use search-and-replace to build a report from these templates. Therefore, I make little use of the Range object. I'm glad you got it going. I've always felt that Word automation was a bit clunky, so, if it were me, I'd be happy if it's doing what I want.

Here's a snippet from one of my templates:



I love how easy it is to get reports designed and operational with this approach. In that [graph2] field, I actually copy-and-paste a constructed plot from Excel, and then paste it (as a picture) into the final Word report (resizing it to be appropriate). I have actually adopted a convention for myself when developing these Word template reports. My "fields" are always word-tags surrounded by square-brackets.

Best of Luck to You,
Elroy

[el84]

All complete and working now, after a few hours of me stumbling in the dark, and this forum. Whole solution follows as promised. I'll now mark this resolved.

'TestWordAutomation
'Project > References > Tick Microsoft Word Object Library (done)

'PURPOSE: TO REPLACE TEXT + JPGS IN TOP OF ONE WORD DOCUMENT
'UP TO THE WORD "AND", WITH ANOTHER COMPLETE DOCUMENT ENDING IN "AND"

'create aaTest dir in My Docs. Within that, create Word files aTestIn and aTestOut
'aTestIn is new; 'aTestOut is standard old and is replaced in tests by copying and renaming fallback

Option Explicit
Dim Version As String
Dim docPath As String
Dim wrdApp As Word.Application
Dim inDoc As Word.Document
Dim outDoc As Word.Document
Dim myRange As Range
Dim getAnd As Range
 
Private Sub Form_Load()
    '#########################################
    lblVersion.Caption = "Version 20 19/1/18"
    '#########################################
    docPath = "C:\Users\Alan\Documents\"
    Set wrdApp = CreateObject("word.application") 'New Word Application?
End Sub

Private Sub cmdDoIt_Click()
    Call docChanger("aTestOut") ' passes output filename *WITHOUT docx* as parameter.
End Sub

Private Sub docChanger(aSmith As String) 'output file parameter. Input file always the same
        '### if error, could be corrupted word doc from tests. Load from file explorer and resave!
                
        'copy whole of Indoc, which must finish with AND
        Set inDoc = wrdApp.Documents.Open(docPath & "aaTest\" & "aTestIn.docx")
        inDoc.ActiveWindow.ActivePane.Selection.WholeStory
        inDoc.ActiveWindow.ActivePane.Selection.Copy
                        
        'open outDoc (the parameter is passed to this and docx added)
        Set outDoc = wrdApp.Documents.Open(docPath & "aaTest\" & aSmith & ".docx")
        
        'find position of AND in outDoc
        Dim EndPos As Integer
        Set getAnd = ActiveDocument.Range
        getAnd.Find.Execute FindText:="AND"
        EndPos = getAnd.Start
        EndPos = EndPos + 4 'includes AND as well as the para mark!
        
        'delete the range up to and including AND and para mark
        Set myRange = ActiveDocument.Range(0, EndPos)
        myRange.Delete
        
        'now paste in the whole of inDoc onto outDoc (goes to top of document by default)
        outDoc.ActiveWindow.ActivePane.Selection.Paste
        
        'and save and leave
        wrdApp.Quit SaveChanges:=wdSaveChanges
                
        'release memory and close form
        Set wrdApp = Nothing
        Set inDoc = Nothing
        Set outDoc = Nothing
        Set getAnd = Nothing
        Set myRange = Nothing
        Unload Me
End Sub
  '#### TO DO
  '## Check OK for both docx and doc

[Elroy]

Nice work, el84.