Help Break links to external document and not table of contents

[Tris1979]

Hi Folks

I have a word document which is opened by an excel Macro. The excel macro calls on a macro in the word document and re saves the word document. The fields in the word document are linked and updated from another excel document.

The word macro I have looks at all the tables deletes empty rows and then empty tables. it then breaks the links to external the excel document using "ActiveDocument.Fields.Unlink"

I have two problems with the macro I cant resolve and I have searched high and low on the web for answers.

Firstly when I run the "ActiveDocument.Fields.Unlink" it breaks all links in the document. not just the links to the external excel document. So I lose the links in the "Number of Pages" on the cover page and also all of the links in documents Table of contents. Is there a way to Unlink only the links to the Excel document. the excel document will always be in the same place and have the same name.

Second problem I have is after my empty tables are cleared I am sometimes left with blank pages. I would also Like to find a way to delete the blank pages. I did manage to find one example of this on the web but it threw up an error on the first line of code.

Below is a copy of the Macro. Thanks in advance for any help.



Sub Clear_Tables_Unlink()




With ActiveDocument.Tables(8)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With


'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(8)
If .Rows.Count < 2 Then .Delete




End With




With ActiveDocument.Tables(7)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With


'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(7)
If .Rows.Count < 2 Then .Delete




End With






With ActiveDocument.Tables(6)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With


'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(6)
If .Rows.Count < 2 Then .Delete




End With






With ActiveDocument.Tables(5)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With


'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(5)
If .Rows.Count < 2 Then .Delete




End With




With ActiveDocument.Tables(4)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With


'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(4)
If .Rows.Count < 2 Then .Delete




End With






With ActiveDocument.Tables(3)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With


'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(3)
If .Rows.Count < 2 Then .Delete




End With






With ActiveDocument.Tables(2)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With


'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(2)
If .Rows.Count < 2 Then .Delete




End With






With ActiveDocument.Tables(1)
For r = .Rows.Count To 1 Step -1
fnd = False
For Each c In .Rows(r).Cells
If InStr(c.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(r).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With


'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(1)
If .Rows.Count < 2 Then .Delete




End With






'**********This is the Section I have the problem with***********************


ActiveDocument.Fields.Unlink





'*********I would like something here to delete any remaining blank pages*********




ActiveDocument.SaveAs2 , _
FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False, CompatibilityMode:=14







End Sub

[gmayor]

The code could be much simpler. The following addresses the link fields, but the blank pages are another issue.

There are no 'pages' in a Word document, so in order to delete pages that display as blank, it is helpful to know why they are blank and what they contain.


Sub Clear_Tables_Unlink()
Dim lngTable As Long
Dim R As Long
Dim C As Cell
Dim fnd As Boolean
Dim fld As Field
Dim oStory As Range

For lngTable = 8 To 1 Step -1
With ActiveDocument.Tables(lngTable)
For R = .Rows.Count To 1 Step -1
fnd = False
For Each C In .Rows(R).Cells
If InStr(C.Range.Text, "0.0") > 0 Then fnd = True
Next
If fnd Then .Rows(R).Delete
'If Not fnd Then .Rows(r).Delete
Next
End With
'Deletes Table Header if no other rows exist in table
With ActiveDocument.Tables(lngTable)
If .Rows.Count < 2 Then .Delete
End With
Next lngTable

'**********This is the Section I have the problem with***********************

For Each oStory In ActiveDocument.StoryRanges
For Each fld In oStory.Fields
If fld.Type = wdFieldLink Then
fld.Unlink
End If
Next fld
If oStory.StoryType <> wdMainTextStory Then
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
For Each fld In oStory.Fields
If fld.Type = wdFieldLink Then
fld.Unlink
End If
Next fld
Wend
End If
Next oStory

'*********I would like something here to delete any remaining blank pages*********

ActiveDocument.SaveAs2 _
FileFormat:=wdFormatXMLDocument, _
LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", _
ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, _
SaveFormsData:=False, SaveAsAOCELetter:=False, _
CompatibilityMode:=Val(Application.Version)

Set oStory = Nothing
End Sub

[Tris1979]

Graham thanks very much for your speedy reply.

I just tested the breaking links to excel and it works perfectly My TOC links are still intact. Thank you!! Will get on to testing your simplified code next.

I have two instances where I want to delete the blank pages the first instance only has the table in it once the macro deletes the table(s) where there is no data the page that the table was in remains. in this instance it will always be the last page/pages that are blank.

The second instance there is a header a footer in the page, again this is the page(s) that are left after the table(s) have been deleted. This will not be the last page in the document.

There will also be page breaks on each page.

In the macro where it looks at each table to see if it is less than two rows, and the deletes the table if it is less than two rows, I want to also delete the page that the table was on.

Thanks again for your help

Tris

[gmayor]

So what you are saying is that each table is on a new page and because there are page breaks when a table is deleted the page is left empty and you want to remove that?
Are the breaks manual page breaks or section breaks?

[Tris1979]

Yes that's exactly it. I would say they are manual. I put them in using, Insert > Page Break.

Your simplified code is working perfectly as well thanks, a lot tidier now.

[gmayor]

Sorry, I got side-tracked and didn't get back to your question about removing the pages.
Perhaps the simplest approach is to replace



With ActiveDocument.Tables(lngTable)
If .Rows.Count < 2 Then .Delete
End With


with



With ActiveDocument.Tables(lngTable)
If .Rows.Count < 2 Then
.Select
ActiveDocument.Bookmarks("\page").Range.Delete
End If
End With