Word merge keeps old fields


Board Regular
Jan 8, 2009
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.

Rich (BB code):
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
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!"
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
AppWd.Documents.Open Filename:="G:\Huge\Big\Specific\ Master Template.doc"
End If 47 Templat = AppWd.ActiveDocument.Name
End If
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
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.

Some videos you may like

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

Watch MrExcel Video

Forum statistics

Latest member

This Week's Hot Topics