Has anyone else seen this bug that crashes out Excel?
PC: Windows XP Pro SP1, Office XP SP3, HP wx6000 workstation.
To replicate:
Cut and paste the code between the dotted lines to a new module and run it.
Ignore the variable names corrupt and so on, that means corrupt data at the
business level in the workbook, not a corrupt .xls file.
Run this code by clicking through and leave the cursor on the line
"lngIncrementThroughCleanWorkbook = 1"
Now, switch to the Excel user interface and try and add an ActiveX control
button. Boom, excel bombs out. I've tried on two PCs here with the same
results. I can probably work around this in a different way, so it's not as
deal breaker, but it's better bad that Excel dies like this.
Any one from Microsoft want to investigate???
------------------------------------------------------------------------------------------------
'Constants
Const strMethodName As String = "Engineering.CorruptWorkBookRebuilder "
Const strInputBoxTitle As String = "Select the broken file"
Const strInputBoxButtonCaption As String = "Fix"
'Variables
Dim oCorruptName As Excel.Name
Dim strCorruptWorkbookName As String
Dim strCleanWorkbookName As String
Dim lngNumberofSheetsInNewWorkbook As Long
Dim lngNumberOfWorksheetsInCorruptWorkbook As Long
Dim lngDefaultNumberOfWorksheetsInWorkbook As Long
Dim lfso As Scripting.FileSystemObject
Dim lngIncrementThroughCleanWorkbook As Long
Dim oCorruptWorkSheet As Excel.Worksheet
Dim oCleanWorksheet As Excel.Worksheet
Dim lvbMsgBoxResult As VBA.VbMsgBoxResult
CorruptWorkBookRebuilder = False
Set lfso = New Scripting.FileSystemObject
lvbMsgBoxResult = MsgBox("You need to ensure that the corrupt workbook is in
a directory with no other files or folders. Is this the case?", vbCritical +
vbYesNo, strMethodName)
If lvbMsgBoxResult = vbYes Then
strCorruptWorkbookName = Application.GetOpenFilename(, ,
strInputBoxTitle, strInputBoxButtonCaption, False)
With Application
.EnableEvents = False
.Calculation = xlCalculationManual
.IgnoreRemoteRequests = True
.DisplayAlerts = False
End With
Set moCorruptWorkbook =
Application.Workbooks.Open(strCorruptWorkbookName, 0, True, , , , , , , , , ,
False)
lngNumberOfWorksheetsInCorruptWorkbook =
moCorruptWorkbook.Worksheets.Count
lngDefaultNumberOfWorksheetsInWorkbook = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = lngNumberOfWorksheetsInCorruptWorkbook
Set moCleanWorkbook = Application.Workbooks.Add
strCleanWorkbookName = lfso.GetBaseName(moCorruptWorkbook.Name)
strCleanWorkbookName = strCleanWorkbookName & "_RECOVERED" &
lfso.GetExtensionName(moCorruptWorkbook.Name)
strCleanWorkbookName = lfso.BuildPath(moCorruptWorkbook.Path,
strCleanWorkbookName)
moCleanWorkbook.SaveAs strCleanWorkbookName
lngIncrementThroughCleanWorkbook = 1
else
end if
------------------------------------------------------------------------------------------------
--
www.alignment-systems.com