I'm getting this error from the JIT compiler at runtime, but only on my boss'
machine, not my development machine. I believe the error is generated from a
call to an Excel object, but I can't tell why or what specific action on the
object is causing it.
We both are running version 2.0 of the .net framework with Office 2003
installed, though I am running XP and she has Win2000. Also, I do not get
this error when running another sub in the same application that also calls
Excel and is otherwise very similar, sharing much of the same code.
This is the offending code (please take it easy, this is my first attempt at
..net and is a port from a VBA app at that):
Module QuickViewer
Public objChosenOne(4) As Object
Public strCode As String
Public strWS As String
Sub QuickView()
Dim e As New Microsoft.Offic e.Interop.Excel .Application
Dim rngCell As Microsoft.Offic e.Interop.Excel .Range
Dim bkQuery As Microsoft.Offic e.Interop.Excel .Workbook
Dim bkLookup As Microsoft.Offic e.Interop.Excel .Workbook
Dim shQuery As Microsoft.Offic e.Interop.Excel .Worksheet
Dim intCount As Integer
Dim intSplit(1) As Integer
Dim strTable As String
Dim intColCount As Integer
'query the appropriate database and return to a new workbook
strTable = objChosenOne(2) .ToString & "-" & objChosenOne(1) .ToString
bkQuery = e.Workbooks.Add
'delete all worksheets except the first
e.DisplayAlerts = False
Do
If bkQuery.Sheets( bkQuery.Sheets. Count).Index 1 Then
bkQuery.Sheets( bkQuery.Sheets. Count).Delete()
Loop Until bkQuery.Sheets. Count = 1
e.DisplayAlerts = True
shQuery = CType(bkQuery.A ctiveSheet,
Microsoft.Offic e.Interop.Excel .Worksheet)
With shQuery.QueryTa bles.Add(Connec tion:="ODBC;DSN =MS Access
Database;DBQ=" & strPath & "\" & objChosenOne(1) & ".mdb;DefaultDi r=" &
strPath & ";DriverId=25;F IL=MS Access;MaxBuffe rSize=2048;Page Timeout=5;",
Destination:=sh Query.Range("$A $1"))
.CommandText = "SELECT `" & strTable & "`.`Record Number`, `" &
strTable & "`.`Workshe et Code`, `" & strTable & "`.Line, `" & strTable &
"`.Column, `" & strTable & "`.Value" & vbCrLf & "FROM `" & strPath & "\" &
objChosenOne(1) & "`.`" & strTable & "` `" & strTable & "`" & vbCrLf & "WHERE
(`" & strTable & "`.`Record Number`=" & objChosenOne(0) & ")"
.Name = "Query from MS Access Database_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFo rmulas = False
.PreserveFormat ting = True
.RefreshOnFileO pen = False
.BackgroundQuer y = True
.RefreshStyle =
Microsoft.Offic e.Interop.Excel .XlCellInsertio nMode.xlInsertD eleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWi dth = True
.RefreshPeriod = 0
.PreserveColumn Info = True
.Refresh(Backgr oundQuery:=Fals e)
End With
shQuery.Columns (2).Insert()
shQuery.Range(" B2",
shQuery.Range(" A2").End(Micros oft.Office.Inte rop.Excel.XlDir ection.xlDown). Offset(0, 1)).Formula = "=C2&D2&E2"
'add worksheet descriptions
bkLookup = e.Workbooks.Ope n(strPath & "\HCRIS Codes.xls")
shQuery.Columns (2).Insert()
With shQuery.Range(" B2:B" & shQuery.Cells(s hQuery.Rows.Cou nt,
1).End(Microsof t.Office.Intero p.Excel.XlDirec tion.xlUp).Row)
.NumberFormat = "General"
.FormulaR1C1 = "=IF(ISERROR(VL OOKUP(RC[2],'" & bkLookup.Name &
"'!HCRISCodes,2 ,0)),"""",VLOOK UP(RC[2],'" & bkLookup.Name &
"'!HCRISCodes,2 ,0))"
.Copy()
..PasteSpecial( Microsoft.Offic e.Interop.Excel .XlPasteType.xl PasteValues)
End With
'sort the workbook
shQuery.Range(" A1:G" & shQuery.Cells(s hQuery.Rows.Cou nt,
1).End(Microsof t.Office.Intero p.Excel.XlDirec tion.xlUp).Row) .Sort(Key1:=shQ uery.Range("D1" ),
Order1:=Microso ft.Office.Inter op.Excel.XlSort Order.xlAscendi ng,
Key2:=shQuery.R ange("F1"),
Order2:=Microso ft.Office.Inter op.Excel.XlSort Order.xlAscendi ng,
Key3:=shQuery.R ange("E1"),
Order3:=Microso ft.Office.Inter op.Excel.XlSort Order.xlAscendi ng,
Header:=Microso ft.Office.Inter op.Excel.XlYesN oGuess.xlYes,
Orientation:=Mi crosoft.Office. Interop.Excel.X lSortOrientatio n.xlSortColumns )
'convert query result from text to general format
For Each rngCell In shQuery.Range(" G1:G" &
shQuery.Cells(s hQuery.Rows.Cou nt,
1).End(Microsof t.Office.Intero p.Excel.XlDirec tion.xlUp).Row)
rngCell.Value = rngCell.Value
Next
'split into individual worksheets
For Each rngCell In shQuery.Range(" D2:D" &
shQuery.Cells(s hQuery.Rows.Cou nt,
2).End(Microsof t.Office.Intero p.Excel.XlDirec tion.xlUp).Row + 1)
If rngCell.Value <rngCell.Offset (-1, 0).Value Then
If rngCell.Value = strCode Then
intSplit(0) = rngCell.Row
End If
If rngCell.Offset(-1, 0).Value = strCode Then
intSplit(1) = rngCell.Offset(-1, 0).Row
End If
End If
Next
If intSplit(0) = 0 Then 'worksheet not found
e.DisplayAlerts = False
e.Quit()
frmQuickView.ss Out.ActiveSheet .Range("C2").Va lue = "Worksheet "
& strWS & " does not exist for this cost report"
frmQuickView.Br ingToFront()
Exit Sub
Else
End If
bkQuery.Workshe ets.Add(After:= bkQuery.Sheets( 1))
shQuery = CType(bkQuery.S heets(1),
Microsoft.Offic e.Interop.Excel .Worksheet)
shQuery.Activat e()
shQuery.Range(s hQuery.Cells(in tSplit(0), 4),
shQuery.Cells(i ntSplit(1), 4)).Copy()
shQuery = CType(bkQuery.S heets(2),
Microsoft.Offic e.Interop.Excel .Worksheet)
shQuery.Activat e()
shQuery.Range(" A2").PasteSpeci al(Microsoft.Of fice.Interop.Ex cel.XlPasteType .xlPasteValues)
shQuery = CType(bkQuery.S heets(1),
Microsoft.Offic e.Interop.Excel .Worksheet)
shQuery.Activat e()
shQuery.Range(s hQuery.Cells(in tSplit(0), 2),
shQuery.Cells(i ntSplit(1), 2)).Copy()
shQuery = CType(bkQuery.S heets(2),
Microsoft.Offic e.Interop.Excel .Worksheet)
shQuery.Activat e()
shQuery.Range(" B2").PasteSpeci al(Microsoft.Of fice.Interop.Ex cel.XlPasteType .xlPasteValues)
shQuery = CType(bkQuery.S heets(1),
Microsoft.Offic e.Interop.Excel .Worksheet)
shQuery.Activat e()
shQuery.Range(s hQuery.Cells(in tSplit(0), 5),
shQuery.Cells(i ntSplit(1), 6)).Copy()
shQuery = CType(bkQuery.S heets(2),
Microsoft.Offic e.Interop.Excel .Worksheet)
shQuery.Activat e()
shQuery.Range(" C2").PasteSpeci al(Microsoft.Of fice.Interop.Ex cel.XlPasteType .xlPasteValues)
'break the "column" column into actual columns
For Each rngCell In shQuery.Range(" D2:D" &
shQuery.Cells(s hQuery.Rows.Cou nt,
4).End(Microsof t.Office.Intero p.Excel.XlDirec tion.xlUp).Row)
If rngCell.Value <rngCell.Offset (-1, 0).Value Then
Try
shQuery.Cells(1 , intColCount + 5).Value = "'" &
CStr(Format(CIn t(rngCell.Value ), "0000"))
Catch
End Try
intColCount = intColCount + 1
End If
Next
shQuery.Columns (4).Delete()
'sort by line number and eliminate duplicate lines
shQuery.Range(" A2:C" & shQuery.Cells(s hQuery.Rows.Cou nt,
1).End(Microsof t.Office.Intero p.Excel.XlDirec tion.xlUp).Row) .Sort(Key1:=shQ uery.Range("C2" ),
Order1:=Microso ft.Office.Inter op.Excel.XlSort Order.xlAscendi ng,
Header:=Microso ft.Office.Inter op.Excel.XlYesN oGuess.xlNo,
Orientation:=Mi crosoft.Office. Interop.Excel.X lSortOrientatio n.xlSortColumns )
For intCount = CLng(shQuery.Ce lls(shQuery.Row s.Count,
1).End(Microsof t.Office.Intero p.Excel.XlDirec tion.xlUp).Row) To 3 Step -1
If shQuery.Cells(i ntCount, 3).Value = shQuery.Cells(i ntCount -
1, 3).Value Then
shQuery.Rows(in tCount).Delete( )
End If
Next
'lookup values
shQuery = CType(bkQuery.S heets(1),
Microsoft.Offic e.Interop.Excel .Worksheet)
shQuery.Activat e()
bkQuery.Names.A dd(Name:="LU", RefersTo:=shQue ry.Range("$C$2: $G$" &
shQuery.Cells(s hQuery.Rows.Cou nt,
3).End(Microsof t.Office.Intero p.Excel.XlDirec tion.xlUp).Row) )
shQuery = CType(bkQuery.S heets(2),
Microsoft.Offic e.Interop.Excel .Worksheet)
shQuery.Activat e()
With shQuery.Range(" D2",
shQuery.Cells(s hQuery.Cells(sh Query.Rows.Coun t,
3).End(Microsof t.Office.Intero p.Excel.XlDirec tion.xlUp).Row, shQuery.Cells(1 ,
shQuery.Columns .Count).End(Mic rosoft.Office.I nterop.Excel.Xl Direction.xlToL eft).Column))
.Formula =
"=IF(ISERROR(VL OOKUP($A2&$C2&D $1,LU,5,0)),""" ",VLOOKUP($A2&$ C2&D$1,LU,5,0)) "
.Copy()
..PasteSpecial( Microsoft.Offic e.Interop.Excel .XlPasteType.xl PasteValues)
End With
'add headings and formatting
shQuery.Range(" A1:C1").Value = "Worksheet Code"
shQuery.Range(" A1:C1").Value = "Worksheet"
shQuery.Range(" A1:C1").Value = "Line"
shQuery.Rows(1) .Font.Bold = True
shQuery.Cells.C olumns.AutoFit( )
shQuery.Columns (1).Hidden = True
shQuery.Range(" D2").Select()
e.ActiveWindow. FreezePanes = True
For Each rngCell In shQuery.Range(" D2",
shQuery.Cells(s hQuery.Cells(sh Query.Rows.Coun t,
3).End(Microsof t.Office.Intero p.Excel.XlDirec tion.xlUp).Row, shQuery.Cells(1 ,
shQuery.Columns .Count).End(Mic rosoft.Office.I nterop.Excel.Xl Direction.xlToL eft).Column))
If IsNumeric(rngCe ll.Value) Then
If rngCell.Value - Int(rngCell.Val ue) <0 Then
rngCell.NumberF ormat = "_(* #,##0.000000_); _(*
(#,##0.000000); _(* ""-""??_);_(@_ )"
Else
rngCell.NumberF ormat = "_(* #,##0_);_(* (#,##0);_(*
""-""??_);_(@_ )"
End If
End If
Next
e.DisplayAlerts = False
bkQuery.Sheets( 1).Delete()
bkQuery.ActiveS heet.Cells.Copy ()
With frmQuickView.ss Out.ActiveSheet
.Range("A1").Pa ste()
.Cells.Interior .ColorIndex = 36
.Range("C2").Se lect()
.Cells.AutoFit( )
End With
'CLEANUP CODE
'brute force method of releasing the COM object may generate error
when object is set to nothing twice
Try
If Not bkQuery Is Nothing Then bkQuery.Close(F alse)
Catch
End Try
Try
If Not bkLookup Is Nothing Then bkLookup.Close( False)
Catch
End Try
Try
If Not e Is Nothing Then e.Quit()
Catch
End Try
Try
rngCell = Nothing
Catch
End Try
Try
shQuery = Nothing
Catch
End Try
Try
bkQuery = Nothing
Catch
End Try
Try
bkLookup = Nothing
Catch
End Try
Try
e = Nothing
Catch
End Try
If Not rngCell Is Nothing Then
Do
If
(System.Runtime .InteropService s.Marshal.Relea seComObject(rng Cell) = 0) Then
Exit Do
Loop
End If
If Not shQuery Is Nothing Then
Do
If
(System.Runtime .InteropService s.Marshal.Relea seComObject(shQ uery) = 0) Then
Exit Do
Loop
End If
If Not bkQuery Is Nothing Then
Do
If
(System.Runtime .InteropService s.Marshal.Relea seComObject(bkQ uery) = 0) Then
Exit Do
Loop
End If
If Not bkLookup Is Nothing Then
Do
If
(System.Runtime .InteropService s.Marshal.Relea seComObject(bkL ookup) = 0) Then
Exit Do
Loop
End If
If Not e Is Nothing Then
Do
If
(System.Runtime .InteropService s.Marshal.Relea seComObject(e) = 0) Then Exit Do
Loop
End If
rngCell = Nothing
shQuery = Nothing
bkQuery = Nothing
bkLookup = Nothing
e = Nothing
System.GC.Colle ct()
End Sub
End Module
Thanks!