Macro won't break links to external spread sheet

[mdetroyer]

I have a template that I update weekly with new data. I've written code to create a "report" for broad distribution each week from this template. The report creation works great except for the fact that the links to the template and another workbook that i use as an image databse won't break. I've run into problems with the links to the workbook that has the images because I am using named ranges and lookup formulas in the named ranges to populate the template. Any thoughts?

Sub NewReport()
Dim Wb1 As Workbook
Dim wb2 As Workbook
Dim RN As String
RN = Range("d1").Value
Dim WMWK As String
WMWK = Sheets("fineline name").Range("j4").Value




With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With


Set Wb1 = ActiveWorkbook


Set wb2 = Application.Workbooks.Add(1)
Wb1.Sheets(Array(Wb1.Sheets(1).Name, Wb1.Sheets(2).Name, Wb1.Sheets(3).Name, Wb1.Sheets(4).Name)).Copy Before:=wb2.Sheets(1)
wb2.Sheets(wb2.Sheets.Count).Delete
wb2.SaveAs ThisWorkbook.Path & "\" & RN & " WK " & WMWK, FileFormat:=52
Call BreakLinks(wb2)


wb2.Close savechanges:=True
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With


End Sub
Sub BreakLinks(ByRef wb2 As Workbook)
Dim LoseLinks As Variant
On Error Resume Next
LoseLinks = wb2.LinkSources(Type:=xlLinkTypeExcelLinks)
On Error GoTo 0
If Not IsEmpty(LoseLinks) Then

For i = 1 To UBound(LoseLinks)
wb2.BreakLink _
Name:=LoseLinks(i), _
Type:=xlLinkTypeExcelLinks
Next i

 

[mdetroyer]

Sorry guys. Here is the code posted correctly.

[COLOR=#333333]Sub NewReport()[/COLOR]
[COLOR=#333333]Dim Wb1 As Workbook[/COLOR]
[COLOR=#333333]Dim wb2 As Workbook[/COLOR]
[COLOR=#333333]Dim RN As String[/COLOR]
[COLOR=#333333]RN = Range("d1").Value[/COLOR]
[COLOR=#333333]Dim WMWK As String[/COLOR]
[COLOR=#333333]WMWK = Sheets("fineline name").Range("j4").Value[/COLOR]




[COLOR=#333333]With Application[/COLOR]
[COLOR=#333333].ScreenUpdating = False[/COLOR]
[COLOR=#333333].DisplayAlerts = False[/COLOR]
[COLOR=#333333].EnableEvents = False[/COLOR]
[COLOR=#333333]End With[/COLOR]


[COLOR=#333333]Set Wb1 = ActiveWorkbook[/COLOR]


[COLOR=#333333]Set wb2 = Application.Workbooks.Add(1)[/COLOR]
[COLOR=#333333]Wb1.Sheets(Array(Wb1.Sheets(1).Name, Wb1.Sheets(2).Name, Wb1.Sheets(3).Name, Wb1.Sheets(4).Name)).Copy Before:=wb2.Sheets(1)[/COLOR]
[COLOR=#333333]wb2.Sheets(wb2.Sheets.Count).Delete[/COLOR]
[COLOR=#333333]wb2.SaveAs ThisWorkbook.Path & "\" & RN & " WK " & WMWK, FileFormat:=52[/COLOR]
[COLOR=#333333]Call BreakLinks(wb2)[/COLOR]


[COLOR=#333333]wb2.Close savechanges:=True[/COLOR]
[COLOR=#333333]With Application[/COLOR]
[COLOR=#333333].ScreenUpdating = True[/COLOR]
[COLOR=#333333].DisplayAlerts = True[/COLOR]
[COLOR=#333333].EnableEvents = True[/COLOR]
[COLOR=#333333]End With[/COLOR]


[COLOR=#333333]End Sub[/COLOR]
[COLOR=#333333]Sub BreakLinks(ByRef wb2 As Workbook)[/COLOR]
[COLOR=#333333]Dim LoseLinks As Variant[/COLOR]
[COLOR=#333333]On Error Resume Next[/COLOR]
[COLOR=#333333]LoseLinks = wb2.LinkSources(Type:=xlLinkTypeExcelLinks)[/COLOR]
[COLOR=#333333]On Error GoTo 0[/COLOR]
[COLOR=#333333]If Not IsEmpty(LoseLinks) Then[/COLOR]

[COLOR=#333333]For i = 1 To UBound(LoseLinks)[/COLOR]
[COLOR=#333333]wb2.BreakLink _[/COLOR]
[COLOR=#333333]Name:=LoseLinks(i), _[/COLOR]
[COLOR=#333333]Type:=xlLinkTypeExcelLinks[/COLOR]
[COLOR=#333333]Next i
[/COLOR]End If

End Sub