Break Links problem

M

Michaelpfreem

Board Regular
Joined
Mar 14, 2008
Messages
92
Hello all,

I am having an issue breaking links in a document using VBA.

Basically I have a document (report) with lots of tabs and formulas and links etc. the macro copies some of the tabs to a new workbook breaks the links, then password protects the new workbook and saves it.

That all works fine, the macro generates the file with the password protection. The problem is it only seems to break the links on the first worksheet, not all of them. Interestingly I tried to replicate the process manually copying each worksheet one at a time and breaking the links, this approach worked, but the macro won't, i even tried recording the macro as I tried the manual attempt and the macro failed to break all the links, it only worked fo rthe first worksheet.

I have tried all sorts of different approachs to get round this problem (see code below). has anyone come across this problem and is there any other way people have found to break links that i might be able to try.

Many thanks in advance for you help:


METHOD 1

****** http-equiv="Content-Type" content="text/html; charset=utf-8">****** name="ProgId" content="Word.Document">****** name="Generator" content="Microsoft Word 11">****** name="Originator" content="Microsoft Word 11"><link rel="File-List" href="file:///C:%5CDOCUME%7E1%5Cmfr%5CLOCALS%7E1%5CTemp%5Cmsohtml1%5C01%5Cclip_filelist.xml"><!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:PunctuationKerning/> <w:ValidateAgainstSchemas/> <w:SaveIfXMLInvalid>false</w:SaveIfXMLInvalid> <w:IgnoreMixedContent>false</w:IgnoreMixedContent> <w:AlwaysShowPlaceholderText>false</w:AlwaysShowPlaceholderText> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> <w:DontGrowAutofit/> </w:Compatibility> <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel> </w:WordDocument> </xml><![endif]--><!--[if gte mso 9]><xml> <w:LatentStyles DefLockedState="false" LatentStyleCount="156"> </w:LatentStyles> </xml><![endif]--><style> <!-- /* Style Definitions */ p.MsoNormal, li.MsoNormal, div.MsoNormal {mso-style-parent:""; margin:0cm; margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:12.0pt; font-family:"Times New Roman"; mso-fareast-font-family:"Times New Roman"; mso-ansi-language:EN-GB;} @page Section1 {size:612.0pt 792.0pt; margin:72.0pt 90.0pt 72.0pt 90.0pt; mso-header-margin:35.4pt; mso-footer-margin:35.4pt; mso-paper-source:0;} div.Section1 {page:Section1;} --> </style><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0cm 5.4pt 0cm 5.4pt; mso-para-margin:0cm; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman"; mso-ansi-language:#0400; mso-fareast-language:#0400; mso-bidi-language:#0400;} </style> <![endif]--> Sub Export()<o:p></o:p>
<o:p> </o:p>
Dim myfilename As String<o:p></o:p>
Dim Links As Variant<o:p></o:p>
Dim i As Integer<o:p></o:p>
<o:p> </o:p>
myfilename = "C:\" & Sheets("Control").Range("BC1").Value & ".xls"<o:p></o:p>
<o:p></o:p>
Windows("report.xls").Activate<o:p></o:p>
Sheets(Array("Page1", "Page2", " Page3", " Page4", " Page5", _<o:p></o:p>
" Page6", " Page7", " Page8", " Page9", " Page10")). _<o:p></o:p>
Select<o:p></o:p>
Sheets("Page1").Activate<o:p></o:p>
Sheets(Array("Page1", "Page2", " Page3", " Page4", " Page5", _<o:p></o:p>
" Page6", " Page7", " Page8", " Page9", " Page10")). _<o:p></o:p>
Copy
<o:p> </o:p>
With ActiveWorkbook<o:p></o:p>
Links = .LinkSources(xlExcelLinks)<o:p></o:p>
If Not IsEmpty(Links) Then<o:p></o:p>
For i = 1 To UBound(Links)<o:p></o:p>
.BreakLink Links(i), xlLinkTypeExcelLinks<o:p></o:p>
Next i<o:p></o:p>
End If<o:p></o:p>
End With<o:p></o:p>
<o:p> </o:p>
ActiveWorkbook.SaveAs Filename:=myfilename, _<o:p></o:p>
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _<o:p></o:p>
ReadOnlyRecommended:=False, CreateBackup:=False<o:p></o:p>
<o:p> </o:p>
<o:p> </o:p>
Sheets("Page1").Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True<o:p></o:p>
Sheets("Page2").Protect Password:=" password ", DrawingObjects:=True, Contents:=True, Scenarios:=True<o:p></o:p>
Sheets("Page3").Protect Password:=" password ", DrawingObjects:=True, Contents:=True, Scenarios:=True<o:p></o:p>
Sheets("Page4").Protect Password:=" password ", DrawingObjects:=True, Contents:=True, Scenarios:=True<o:p></o:p>
Sheets("Page5").Protect Password:=" password ", DrawingObjects:=True, Contents:=True, Scenarios:=True<o:p></o:p>
Sheets("Page6").Protect Password:=" password ", DrawingObjects:=True, Contents:=True, Scenarios:=True<o:p></o:p>
Sheets("Page7").Protect Password:=" password ", DrawingObjects:=True, Contents:=True, Scenarios:=True<o:p></o:p>
Sheets("Page8").Protect Password:=" password ", DrawingObjects:=True, Contents:=True, Scenarios:=True<o:p></o:p>
Sheets("Page9").Protect Password:=" password ", DrawingObjects:=True, Contents:=True, Scenarios:=True<o:p></o:p>
Sheets("Page10").Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True<o:p></o:p>
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever<o:p></o:p>
ActiveWorkbook.Save<o:p></o:p>
ActiveWorkbook.Close<o:p></o:p>
Windows("report.xls").Activate<o:p></o:p>
<o:p></o:p>
End Sub




METHOD 2




****** http-equiv="Content-Type" content="text/html; charset=utf-8">****** name="ProgId" content="Word.Document">****** name="Generator" content="Microsoft Word 11">****** name="Originator" content="Microsoft Word 11"><link rel="File-List" href="file:///C:%5CDOCUME%7E1%5Cmfr%5CLOCALS%7E1%5CTemp%5Cmsohtml1%5C01%5Cclip_filelist.xml"><!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:PunctuationKerning/> <w:ValidateAgainstSchemas/> <w:SaveIfXMLInvalid>false</w:SaveIfXMLInvalid> <w:IgnoreMixedContent>false</w:IgnoreMixedContent> <w:AlwaysShowPlaceholderText>false</w:AlwaysShowPlaceholderText> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> <w:DontGrowAutofit/> </w:Compatibility> <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel> </w:WordDocument> </xml><![endif]--><!--[if gte mso 9]><xml> <w:LatentStyles DefLockedState="false" LatentStyleCount="156"> </w:LatentStyles> </xml><![endif]--><style> <!-- /* Style Definitions */ p.MsoNormal, li.MsoNormal, div.MsoNormal {mso-style-parent:""; margin:0cm; margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:12.0pt; font-family:"Times New Roman"; mso-fareast-font-family:"Times New Roman"; mso-ansi-language:EN-GB;} @page Section1 {size:612.0pt 792.0pt; margin:72.0pt 90.0pt 72.0pt 90.0pt; mso-header-margin:35.4pt; mso-footer-margin:35.4pt; mso-paper-source:0;} div.Section1 {page:Section1;} --> </style><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0cm 5.4pt 0cm 5.4pt; mso-para-margin:0cm; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman"; mso-ansi-language:#0400; mso-fareast-language:#0400; mso-bidi-language:#0400;} </style> <![endif]--> Sub Export2()<o:p></o:p>
<o:p> </o:p>
Dim myfilename As String<o:p></o:p>
Dim bookname As String<o:p></o:p>
Dim Links As Variant<o:p></o:p>
Dim i As Integer<o:p></o:p>
<o:p> </o:p>
myfilename = "C:\" & Sheets("Control").Range("BC1").Value & ".xls"<o:p></o:p>
bookname = Sheets("Control").Range("BC1").Value & ".xls"<o:p></o:p>
<o:p></o:p>
Windows("report.xls").Activate<o:p></o:p>
Sheets("Page1").Select<o:p></o:p>
Sheets("Page1").Activate<o:p></o:p>
Sheets("Page1").Copy<o:p></o:p>
<o:p> </o:p>
With ActiveWorkbook<o:p></o:p>
Links = .LinkSources(xlExcelLinks)<o:p></o:p>
If Not IsEmpty(Links) Then<o:p></o:p>
For i = 1 To UBound(Links)<o:p></o:p>
.BreakLink Links(i), xlLinkTypeExcelLinks<o:p></o:p>
Next i<o:p></o:p>
End If<o:p></o:p>
End With<o:p></o:p>
<o:p> </o:p>
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever<o:p></o:p>
<o:p> </o:p>
ActiveWorkbook.SaveAs Filename:=myfilename, _<o:p></o:p>
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _<o:p></o:p>
ReadOnlyRecommended:=False, CreateBackup:=False<o:p></o:p>
<o:p></o:p>
ActiveWorkbook.Save<o:p></o:p>
ActiveWorkbook.Close<o:p></o:p>
Workbooks.Open (myfilename)<o:p></o:p>
<o:p></o:p>
Windows("report.xls").Activate<o:p></o:p>
Sheets("Page2").Select<o:p></o:p>
Sheets("Page2").Activate<o:p></o:p>
Sheets("Page2").Copy Before:=Workbooks(bookname).Sheets(1)<o:p></o:p>
<o:p></o:p>
Windows(bookname).Activate<o:p></o:p>
Sheets("Page2").Select<o:p></o:p>
<o:p></o:p>
With ActiveWorkbook<o:p></o:p>
Links = .LinkSources(xlExcelLinks)<o:p></o:p>
If Not IsEmpty(Links) Then<o:p></o:p>
For i = 1 To UBound(Links)<o:p></o:p>
.BreakLink Links(i), xlLinkTypeExcelLinks<o:p></o:p>
Next i<o:p></o:p>
End If<o:p></o:p>
End With<o:p></o:p>
<o:p> </o:p>
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever<o:p></o:p>
ActiveWorkbook.Save<o:p></o:p>
ActiveWorkbook.Close<o:p></o:p>
Workbooks.Open (myfilename)<o:p></o:p>
<o:p></o:p>
((((((REPEAT FOR REST OF THE PAGES)))))
<o:p> </o:p>
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever<o:p></o:p>
ActiveWorkbook.Save<o:p></o:p>
ActiveWorkbook.Close<o:p></o:p>
Windows("report.xls").Activate
<o:p> </o:p>
End Sub


Thanks again,
Mike
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
Try changing this

Code: 
With ActiveWorkbook<?XML:NAMESPACE PREFIX = O /><O:P></O:P>
Links = .LinkSources(xlExcelLinks)<O:P></O:P>
If Not IsEmpty(Links) Then<O:P></O:P>
For i = 1 To UBound(Links)<O:P></O:P>
.BreakLink Links(i), xlLinkTypeExcelLinks<O:P></O:P>
Next i<O:P></O:P>
End If<O:P></O:P>
End With<O:P></O:P>
<O:P></O:P>

to this

Code: 
 For Each WS In ActiveWorkbook.Worksheets
Links = .LinkSources(xlExcelLinks)<O:P></O:P>
If Not IsEmpty(Links) Then<O:P></O:P>
For i = 1 To UBound(Links)<O:P></O:P>
.BreakLink Links(i), xlLinkTypeExcelLinks<O:P></O:P>
Next i<O:P></O:P>
End If<O:P></O:P>
Next WS
<O:P></O:P>

At the very beginning of the code you need to add

Code: 
Dim WS As Worksheet
 
Upvote 0
Thanks for the reply, your approach throws up an error for the line:

Links = .LinkSources(xlExcelLinks)

The error is

Complie error:
Invalid or unqualified reference

I'm not sure why this is?

Thanks,
Mike
 
Upvote 0
This code will break all links, although if there are a lot it does sometimes need to run twice but other than that it does exactly what is says on the tin.

Sub BreakLinks()
Dim LinksList As Variant
Dim i As Integer
LinksList = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
If IsArray(LinksList) Then
For i = LBound(LinksList) To UBound(LinksList)
ActiveWorkbook.BreakLink Name:=LinksList(i), Type:=xlLinkTypeExcelLinks
Next i
End If
End Sub

Not my code but acquired from this forum.
 
Upvote 0
You could try a different approach.

I have to create an unlinked version of a large report to reduce the size for emailing.

To do this I break the links then file saves as, which will preserve the original.

You could just add some delete tabs code to this:

Private Sub BreakLinks()

Run "UnProtectAllSheets"

Dim LinksList As Variant
Dim i As Integer
LinksList = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
If IsArray(LinksList) Then
For i = LBound(LinksList) To UBound(LinksList)
ActiveWorkbook.BreakLink Name:=LinksList(i), Type:=xlLinkTypeExcelLinks
Next i
End If

Run "ProtectAllSheets"

On Error GoTo Etrap

Dim MyCell
MyCell = Sheets("Header").[D10].Value & " " & Sheets("Header").[D12].Value

'ask user to save
If MsgBox("Save new workbook as " & CurDir & "\" & MyCell & ".xls?", vbYesNo) = vbNo Then
Exit Sub
End If

'check value of activecell
If MyCell = "" Then
MsgBox "Please check the Cell Value", vbInformation
Exit Sub
End If

'save activeworkbook as new workbook
ActiveWorkbook.SaveAs Filename:=MyCell & ".xls", _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Etrap:

Beep
Exit Sub

End Sub


The Unprotectall & protectall macros called to run are:

Dim Shts As Worksheet
Private Sub UnProtectAllSheets()
'Unprotects ALL worksheets
Application.ScreenUpdating = False
For Each Shts In ThisWorkbook.Worksheets
Shts.Unprotect Password:="Password of Choice"
Next
Application.ScreenUpdating = True
End Sub

Sub ProtectAllSheets()
'Protects ALL worksheets
Application.ScreenUpdating = False
For Each Shts In ThisWorkbook.Worksheets
Shts.Protect Password:="Password of Choice"
Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi,
Try VBA below
Code: 
Sub BreakLinks()
    Dim aLinksArray As Variant
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    
    
    aLinksArray = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
    
    Do Until IsEmpty(aLinksArray)
        ActiveWorkbook.BreakLink Name:=aLinksArray(1), Type:=xlLinkTypeExcelLinks
        aLinksArray = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
    Loop
    
     Application.ScreenUpdating = True
     Application.DisplayAlerts = True
     Application.Calculation = xlCalculationAutomatic
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
2K
Attrazion
A
D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
617
smozgur
smozgur
E
  • Solved
Macro to run anytime a ActiveX checkbox is used (no linked cells)
Replies
8
Views
775
John_w
J
G
  • Question Question
Workbook formulas copied with Sheet references in new Workbook
Replies
0
Views
404
GK039
G
T
  • Question Question
Problem using Autofilter when sheet is protected
Replies
0
Views
605
Tonysdilemma
T

Forum statistics

Threads
1,224,518
Messages
6,179,253
Members
452,900
Latest member
LisaGo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top