Copy Text from one Directory and create new to Paste into

[bennymc]

This might be a little complicated, though it might be relatively simple. I kinda know it can be done but I lack the ability to work it out properly.


I'll put it into bullet points anyway to be as clear as I can:


- I have two Directories
- In Directory one (Dir 1), I have a single letterhead template with merge fields for name/address/salutation etc.
- In Directory two (Dir 2), I have hundreds of old letters, from which the body's (From 'Dear X' to 'Yours sincerely') need to be extracted and Inserted into the Template in Directory one (Creating a new template for each old letter


I'm looking to create a code that (amongst saving me hours) will:


- Duplicate the template in Dir 1
- Look in Dir 2, get the name of the first document and give that name to the newly made (duplicate) template in Dir 1
- Search the Document in Dir 2 for all text between the words 'Dear' and 'Yours Sincerely'
- Copy that text and Paste it into the New Template in Dir1
- Close the
- Save and Close the new Template
- Loop until all files in Dir 2 have been copied


I already have code that will call a macro to run on every file in a directory until conclusion:




Sub EditAll()
Dim file
Dim path As String

'ALWAYS unclude a '\' at the end of the file path
path = "FILE PATH HERE"


'Set Document Type here
file = Dir(path & "*.dot")

Do While file <> ""
Documents.Open FileName:=path & file


Call TYPE MACRO NAME HERE

ActiveDocument.Save
ActiveDocument.Close

file = Dir()
Loop
End Sub


Can anyone help me here? Thanks in advance :)

[westconn1]

when working with multiple documents, you need to be sure that you always know which document you are referring to, best way is to use document object varaibles


try like

mypath = "dir 2\" ' change as required to full path
savepath = "dir 1\" ' change to full path
template = "dir 1\newletterhead.dot" ' change to suit as full path

file = Dir(mypath & "*.dot")
Do While file <> ""
set olddoc = documents.open(mypath & file)
set nexdoc = Documents.add template
' here you need the code to do the appropriate changes to nexdoc from content of olddoc
Dim r As Range, fnd As Range
Set r = olddoc.Content
Set fnd = olddoc.Content
With fnd.Find
.Execute ("Dear")
End With
r.Start = fnd.Start
Set fnd = olddoc.Content
With fnd.Find
.Execute ("Yours Sincerely")
r.End = fnd.End
End With
nexdoc.range = r ' you may have to play with the position where the text is placed, depending on existing content in the template
nexdoc.SaveAs savepath & file
nexdoc.Close
olddoc.close false

file = Dir()
Loop this is as a whole untested, most parts are tested individually