Word merge keeps old fields

[corquando]

Howdy, Excel world.

Here's one I haven't even seen before.

I have a program that opens a Word doc, links it to a worksheet and merges. So far, kindergarten stuff.

Since I have a number of different types of docs I produce daily, each with its own set of data fields, the page I link to is populated with data particular to one style of doc, linked, merged and then deleted after the production run. Then a new page is added in the same spot, given the same name and a different set of data fields and data are loaded in.

As well, I open a new Word.App for every different source page (Set AppWd = CreateObject("Word.Application")) and then quit after each type so it's also gone.

I do that so that I don't have 17 different merge codes with one variable unique to each. Populating one sheet and running the same code is a whole lot more efficient.

Up until yesterday this worked fine - for, like, years. Then, for some reason, out of the blue, now when I open and start to process a new doc, it tries to link to the old field set, even though that page was deleted and a new one added and populated.

So, since it quits, the application should unlink but it doesn't . . . ?

Additional weirdness: When I manually open one of the docs, it tries to link to the old source page fields, regardless of whether it is the type that was last run successfully or not. This is true even after having the desktop shut down overnight.

MORE additional weirdness: If I manually Save the Excel workbook after repopulating the source page, then manually Open a new Word doc, it links fine. Sometimes I have to open the Existing Source table, sometimes not, but it always links up.

BUT . . . that doesn't work when I do an "ActiveWorkbook.Save" in the VBA code after each new source page population.

The only thing I can come up with that's different is that I took the program from "Activate" and "Select" when choosing worbooks, worksheets and ranges to "Set = " so that I wouldn't be skipping code.

For your elucidation, I here now present the code in its entirety.

Excel/Word 2007, XP Pro OS.

Sub DoxMakerTest()
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
Dim DocName As String
Dim DocNum As String
Dim DoxName As String
Dim NextDoc As String
Dim Carbon As New FileSystemObject
Dim Lookee As New FileSystemObject
Dim Mimeo As Document
Dim CoreDoc As Boolean
Dim Arr As Integer
Dim Templat As String
Dim WB As Workbook
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim WS3 As Worksheet
 
'Init
ActiveWorkbook.Save ‘”Dox” repopulated in immediately previous sub​
0 Set WB = Workbooks("MergeFile.xlsm")
Set WS1 = WB.Sheets("Dox") ‘Merge fields
Set WS2 = WB.Sheets("Map") ‘Creation of metadata for doc style identification and titling.
Set WS3 = WB.Sheets("Outfile") ‘Email program assembly sheet - unrelated here​
CoreDoc = False ‘Doc type determinant
Application.DisplayAlerts = False
x = Sheets("Map").Range("A2").End(xlDown).Row​
<o:p></o:p>
'Starts application<o:p></o:p>
10 Set AppWd = CreateObject("Word.Application")
AppWd.Visible = True
 
For i = 2 To x​
'Gets DocName and sets DoxName<o:p></o:p>
20 If WS2.Range("A" + CStr(i)) = "" Then Exit Sub
DocNum = Left(WS2.Range("A" + CStr(i)), 4)
DoxName = WS2.Range("D" + CStr(i))
NextDoc = WS2.Range("A" + CStr(i + 1)) + ".doc"
If Z <> 1 Then PrevDoc = WS2.Range("A" + CStr(i - 1)) + ".doc"​
<o:p></o:p>
'Opens Dox template<o:p></o:p>
40 If DocIsOpen(DocName) = False Then ‘Function: Doc 'identification - one type of doc has unique title<o:p></o:p>​
If InStr(1, DocNum, " ") = 0 Then
Call FindFile(DocNum, DocName)'Finds correct doc type
Else
DocName = WS2.Range("A" + CStr(i)) + ".doc"​
End If​
'Obtain correct doc - various docs in various locations, some have templates to which<o:p></o:p>
‘static text is added after, some are simple merge docs.<o:p></o:p>
44 If Lookee.FileExists("I:\Huge\Big\Specific\PROFILES \" + DocName) Then
AppWd.Documents.Open
Filename:="I:\Huge\Big\Specific\PROFILES\" + DocName
CoreDoc = True ‘Primary type​
ElseIf Lookee.FileExists("G:\Huge\Big\Specific\" + DocName) Then
AppWd.Documents.Open
Filename:="G:\Huge\Big\Specific\" + DocName
CoreDoc = False ‘Alternate type​
Else ‘Type missing
Arr = MsgBox("There's a missing document. Would you like to stow the entry for later?", vbYesNo, "Missing Doc")
 
If Arr = 7 Then
MsgBox "Find the document or issue and come back.", vbOKOnly, "FIX NOW!"​
Else
Sheets("Dox").Rows((i)).Cut 
Sheets("Holding").Range("A1").Insert
Sheets("Dox").Rows((i)).Delete
GoTo 111​
End If​
End If​
End If​
46 If CoreDoc = True Then 'Process certain type of doc
If WS1.Range("J" + CStr(i)) = 1220 Or WS1.Range("J" + CStr(i)) = 1245 Then
AppWd.Documents.Open Filename:="G:\Huge\Big\Specific\Master Template1245.doc"
GoTo 47​
ElseIf WS1.Range("O" + CStr(i)) = "VIP" Then
AppWd.Documents.Open Filename:="G:\Huge\Big\Specific\VIP Template.doc"
GoTo 47​
Else
AppWd.Documents.Open Filename:="G:\Huge\Big\Specific\ Master Template.doc"​
End If
47 Templat = AppWd.ActiveDocument.Name​
End If​
AppWd.Documents(DocName).Activate​
If CoreDoc = True Then
'Do some things - no merge functions happen here. Simple cut 'n' paste of static text if needed according to doc type.<o:p></o:p>
End If​
'The Link - copied right out of a recorded Word macro
AppWd.ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
AppWd.ActiveDocument.MailMerge.OpenDataSource Name:= _
"G:\Huge\Big\Workbooks\MergeFile.xlsm" _
, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=G:\Huge\Big\Workbooks\MergeFile.xlsm;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Je" _
, SQLStatement:="SELECT * FROM `Dox$`", SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess​
AppWd.Selection.HomeKey Unit:=wdStory 'unlock all data fields to prevent warning doc about locked data fields​
With AppWd.Selection
.Expand Unit:=wdSentence
.Extend
.Extend
.Extend
.Extend
End With​
AppWd.Selection.Fields.Locked = False
AppWd.Selection.HomeKey Unit:=wdStory 'returns cursor to top of doc 
 
AppWd.ActiveDocument.MailMerge.DataSource.ActiveRecord = i - 1 'get record, account for sheet header
 
AppWd.ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle​
'Creates dox
With AppWd.ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = AppWd.ActiveDocument.MailMerge.DataSource.ActiveRecord
.LastRecord = AppWd.ActiveDocument.MailMerge.DataSource.ActiveRecord
End With​
.Execute Pause:=False
End With
AppWd.Selection.WholeStory
AppWd.Selection.Font.Name = "Times New Roman"​
'Saves finished dox to correct folders
AppWd.ActiveDocument.SaveAs Filename:="G:\Huge\Big\Specific\Finished\" + DoxName + ".doc"​
110 AppWd.ActiveDocument.Close False​
‘If a template was opened, close it now 
If TemplatIsOpen(Templat) = True Then AppWd.Documents(Templat).Close False​
<o:p></o:p>
‘Close the doc only if it’s not the next one up again <o:p></o:p>
If DocName <> NextDoc Then AppWd.ActiveDocument.Close False​
111 Next​
‘Buh-bye<o:p></o:p>
Application.DisplayAlerts = True
AppWd.Visible = False
AppWd.Quit​
End Sub

I've removed the ancillary stuff like error handlers and whatnot since they're not germane to the issue.

I've also posted this at WordBanter, just in case it is a Word issue.

Hoping to get there soon, since this is a daily task . . .

Thanks to all.