将MSHFlexgrid显示的数据存入数组，再将数组导出至EXCEL，出现以下错误：应用程序定义错误或对象定义错误！ 跪请解决！

Question

如题：　原代码如下(其中mrc是为查询出的库存记录集)Dim strcaption As String
Dim sn As String
Dim i As Single
Dim recs As Integer
Dim counter As IntegerPrivate Type exlcell
row As Long
col As Long
End Type
'复制recordset中数据到excel表格worksheet
Private Sub copyrecords(rst As ADODB.Recordset, ws As Worksheet, startingcell As exlcell)
Dim somearray() As Variant
Dim row As Long
Dim col As Long
Dim fd As ADODB.Field
On Error GoTo err_copyrecords
'检测recordset中是否有数据
If rst.EOF And rst.BOF Then Exit Sub
rst.MoveLast
ReDim somearray(rst.RecordCount + 1, rst.Fields.Count)
'拷贝头到数组
col = 0
For Each fd In rst.Fields
    somearray(0, col) = fd.Name
    col = col + 1
Next
'拷贝recordset到数组
rst.MoveFirst
recs = rst.RecordCount
counter = 0
For row = 1 To rst.RecordCount - 1
    counter = counter + 1
    If counter <= recs Then i = (counter / recs) * 100
    For col = 0 To rst.Fields.Count-1
       somearray(row, col) = rst.Fields(col).Value
       If IsNull(somearray(row, col)) Then somearray(row, col) = ""
    Next
    rst.MoveNext
Next
'将数组填充到excel worksheet
'range应该和数组拥有同样的行数和列数
ws.Range(ws.Cells(startingcell.row, startingcell.col), ws.Cells(startingcell.row + rst.RecordCount + 1, startingcell.col + rst.Fields.Count)).Value = somearrayexit_copyrecords:
On Error GoTo 0
Exit Suberr_copyrecords:
    Select Case Err
        Case 0
              Resume Next
        Case Else
              MsgBox "错误:" & Err.Number & vbNewLine & Err.Description, vbMsgBoxHelpButton, "错误"
              Resume exit_copyrecords
    End Select
End Sub
'将recordset数据转换到excel中
Private Sub toexcel(sn As ADODB.Recordset, strcaption As String)
Dim oexcel As Object
Dim objexlsht As Worksheet
Dim stcell As exlcell
On Error GoTo err_toexcel
DoEvents
    On Error Resume Next
    Set oexcel = GetObject(, "excel.application")
    '若excel没启动
    If Err = 429 Then
       Err = 0
       Set oexcel = CreateObject("excel.Application")
       '无法创建对象
       If Err = 429 Then
       MsgBox Err & ":" & Error, vbExclamation + vbOKOnly
       Exit Sub
    End If
    End If
    oexcel.Workbooks.Add
    oexcel.Worksheets("sheet1").Name = strcaption
    Set objexlsht = oexcel.ActiveWorkbook.Sheets(1)
    strcell.row = 1
    strcell.col = 1
    '填充excel表格
    copyrecords sn, objexlsht, stcell
    '将控制权交给用户
    oexcel.Visible = True
    oexcel.Interactive = True
    '测试对象是否活动并释放对象
    If Not (objexlsht Is Nothing) Then
       Set objexlsht = Nothing
    End If
    If Not (oexcel Is Nothing) Then
       Set oexcel = Nothing
    End If
    If Not (sn Is Nothing) Then
       Set sn = Nothing
    End If
exit_toexcel:
    On Error GoTo 0
    Exit Sub
err_toexcel:
    Select Case Err
        Case 0
            Resume Next
        Case Else
            MsgBox "错误:" & Err.Number & vbNewLine & Err.Description, vbInformation, "错误"
            Resume exit_toexcel
    End Select
End Sub
FORM中一个按钮，调用事件如下：private sub out_excel.click()
                              call toexcel(mrc,"库存报表")
                              end sub

Answer 1

反正mrc是一个查询记录集，它没问题,你不用管它，程序调试没指向哪行出错，就是在excel出现完后弹出这个错误窗口

Answer 2

单步调试一下吧，看在哪句出错。另：
copyrecords是什么过程？做什么操作？

Answer 3

fishmans(金脚指) 　　没有指向哪句出错啊，在最后excel打开窗口后才弹出：应用程序定义错误或对象定义错误！　　　　copyrecords过程就是一个导出到excel的过程啊！　我写的代码怎么难理解？？

Answer 4

你先把On Error GoTo ...这些语句注释，然后运行看是什么地方出错

Answer 5

一样，没提示哪个地方出错，在程序运行完后，启动到excel时就出现上面的提示错误！一行一行调试也没提示具体哪行出错

Answer 6

Dim objexlsht As Worksheet
Dim stcell As exlcell
___________________________________________________工程中有对Excel类库引用吗？  strcell.row = 1
    strcell.col = 1
——————————————————————
这个strcell是个什么？在哪里定义？

Answer 7

那是一段代码啊，包括2个函数　　　TO winehero(编程人生)，是stcell，多打了一个r,上面有定义的！你们能不能把代码复制下来调试啊，光这样看怎么帮我解决啊，晕死！我多加了些注释而已，要是难看你们可以复制下来删除掉啊，唉，这么点代码都长？？？？高手？？？？郁闷！！！

Answer 8

楼主，叫你把On Error Goto/Resume Next 这些语句去掉你怎么不肯啊，去掉了就看到有语句提示错误了
我试了一下，把On Error 这些语句去掉了，这句有错误提示 Set oexcel = GetObject(, "excel.application")，应该改为Set oexcel = CreateObject("excel.application")
另外，strcell没有定义
这里也有错误：
ws.Range(ws.Cells(startingcell.row, startingcell.col), ws.Cells(startingcell.row + rst.RecordCount + 1, startingcell.col + rst.Fields.Count)).Value = somearray

Answer 9

问题解决了：
只要把
Set oexcel = GetObject(, "excel.application")
改为
Set oexcel = CreateObject("excel.application")
还有定义是stcell，使用时却是strcell，把它也改过来就一切OK!!

Answer 10

我上面的代码里有啊 如下：　　　　On Error Resume Next
    Set oexcel = GetObject(, "excel.application")
    '若excel没启动
    If Err = 429 Then
       Err = 0
       Set oexcel = CreateObject("excel.Application")
       '无法创建对象
       If Err = 429 Then
       MsgBox Err & ":" & Error, vbExclamation + vbOKOnly
       Exit Sub
    End If

Answer 11

好了，谢谢 faysky2() 结帐了！