Question

vb运行提示实时错误91 对象变量或with块变量未设置

Private Sub Cmd3_Click()
Dim a As Ccc
constr = App.Path & "\" & "fp.mdb"
constr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & constr
Set con = New ADODB.Connection
con.CursorLocation = adUseClient
con.Open constr
Set rs = New ADODB.Recordset
sql = "SELECT order.* FROM [order];"
rs.Open Trim$(sql), con, adOpenDynamic, adLockOptimistic '得到记录

If Not rs.EOF Then
a.ExporToExcel rs 出错的地方
Text1.Text = "导出数据成功!"
Else
MsgBox "无EXCEL导出数据"
Text1.Text = "导出数据失败"
End If

Sub ExporToExcel(Rs_Data As ADODB.Recordset)
IrowCount As Integer
'If BlnCanoutput = False Then
' MsgBox "对不起，你没有数据输出的权限！", vbOKOnly + vbInformation, "系统提示"
' Exit Sub
'End If
Dim IcolCount As Integer

Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlQuery As Excel.QueryTable
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlBook = xlApp.Workbooks().Add
Set xlSheet = xlBook.Worksheets("sheet1")
xlApp.Visible = True

With Rs_Data
If .RecordCount < 1 Then
MsgBox ("没有记录!")
Exit Sub
End If
'记录总数
IrowCount = .RecordCount
'字段总数
IcolCount = .Fields.Count
End With

' xlSheet.Cells(1, 3) = "报表标题"
'添加查询语句，导入EXCEL数据

Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a2"))

With xlSheet
.Range(.Cells(1, 1), .Cells(1, IcolCount)).Font.Name = "黑体"
'设标题为黑体字
.Range(.Cells(1, 1), .Cells(1, IcolCount)).Font.Bold = True
'标题字体加粗
.Range(.Cells(1, 1), .Cells(IrowCount + 1, IcolCount)).Borders.LineStyle = xlContinuous
'设表格边框样式
End With

xlQuery.FieldNames = True '显示字段名
xlQuery.Refresh
xlApp.Application.Visible = True
Set xlApp = Nothing '"交还控制给Excel
Set xlBook = Nothing
Set xlSheet = Nothing
End Sub

Answer 1

建议： 　　如今的市场竞争日益激烈，服务成为争取客户的重要手段，邮购是其中不可或缺的内容。对一个邮购管理系统来说，客户数据管理和打印是必备的功能。如果邮购客户的信息量不大，使用数据库有点“大材小用”。Excel