Form button crashes XL2007
 

Hello,

I have an application consisting of 2 workbooks, Weekly Entries and
Monthly Summary. There are links from the Monthly back to the
Weekly. At the end of the week, a procedure is run from the Weekly
file that has 3 main steps: 1) Weekly is 'saved as' with a new, date
related name. 2) data is cleared from the new Weekly. 3) the
Monthly file is opened and links are added to the new Weekly.

This application has run without a problem for over a year, until the
client recently upgraded to XL2007 - then he started experiencing
frequent Excel crashes.

After heading down many false trails, I finally discovered that the
procedure would run without fail from the VBE, but would crash XL if
activated by the form button on the worksheet. After realizing that,
I tried changing the form button to an ActiveX button, and voila! -
the trouble went away.

The simplified code below will demonstrate the problem. If you
comment out the 'add link' line, the procedure will run without fail.
Likewise, if the 'save as' line is commented out. There seems to be
some issue with saving as a new file name, adding a link and using a
form button. I'm hoping that someone who knows a lot more about this
than I do can offer me an explanation. All I know is that this runs
OK with XL97. This might be an instance of XL2007 backward
compatibility not working as expected.

Thank you

Regards,

Dave


Sub RollWeekly()

Dim strLink As String
Dim strSource As String, str As String
Dim x As Integer, r As Long

ChDir ThisWorkbook.Path
Set wbkS = ThisWorkbook

'extract file index
str = wbkS.Name
str = Mid(str, InStr(str, "_") + 1)
x = Left(str, InStr(str, ".") - 1)

'increment index and save
strSource = "Weekly_" & x + 1
wbkS.SaveAs Filename:=strSource, FileFormat:=52

'define link
strLink = "= '" & CurDir & "\[" & strSource & "]Sheet1'!$A$1"

'open target
Workbooks.Open Filename:=CurDir & "\Target.xlsx",
UpdateLinks:=xlUpdateLinksNever
Set wbkT = ActiveWorkbook
wbkT.Worksheets(1).Select

'find next target row
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
r = ActiveCell.Row

'add links
ActiveSheet.Cells(r, 1).Formula = strLink

'save & close target
wbkT.Close savechanges:=True

Set wbkT = Nothing
Set wbkS = Nothing

End Sub