VB导出excel第二次报错
Private Sub Command4_Click()
If Adodc1.Recordset.RecordCount = 0 Then Exit Sub '如果当前表格无数据，则退出过程
Dim xlApp As excel.Application '定义EXCEL类
Dim xlBook As excel.Workbook '定义工件簿类
Dim xlsheet As excel.Worksheet '定义工作表类
Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlBook = xlApp.Workbooks.Add '添加空文档
xlApp.Visible = True '设置EXCEL对象可见
Set xlsheet = xlBook.Worksheets("sheet1") '设置活动工作表
xlApp.ScreenUpdating = False '屏幕更新关
'给excel定义标题栏
With xlsheet
.Range("A1").Value = "A"
.Range("B1").Value = "B"
.Range("C1").Value = "C"
.Range("D1").Value = "D"
.Range("E1").Value = "E"
.Range("F1").Value = "F"
.Range("G1").Value = "G"
.Range("H1").Value = "H"
.Range("I1").Value = "I"
.Range("J1").Value = "J"
.Range("K1").Value = "K"
.Range("L1").Value = "L"
.Range("M1").Value = "M"
.Range("N1").Value = "N"
End With
xlsheet.Range("A2").CopyFromRecordset Adodc1.Recordset '从主窗体的表格中导出数据
'给excel表格加边框
Dim lCols As Long
Dim lRows As Long
lRows = xlsheet.UsedRange.Cells.Rows.Count '判断行数
If lRows > 3 Then '如果行数lrows大于3，则加边框
xlsheet.Range("A1:O" & lRows).Select
xlsheet.Range("A1").Activate
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End If
xlsheet.Range("A1:O1").HorizontalAlignment = xlCenter '调整居中对齐
xlsheet.Columns("A:B").HorizontalAlignment = xlCenter
xlsheet.Cells.Font.Size = 9
xlsheet.Columns(1).ColumnWidth = 12 '调整列宽
'保存导出的文件
If Dir(App.Path & "\导出", vbDirectory) = "" Then MkDir App.Path & "\导出" '如果不存在文件夹则创建之
'在退出窗体前，释放excel相应变量
xlBook.Close
Set xlsheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing '注意：xlApp要先Quit，后Nothing
End Sub
这一段程序是用datagrid1d的数据导出到excel表，在编程里，点N次导出都很正常，但当编译成exe文件后运行，第一次导出正常，第二次导出就提示“91 with未设置.....”. 第二个问题是：当我直接打开保存的excel表时，excel程序就停在那，表也打不开。
请帮忙看看哪出错了！
谢！
[解决办法]
我把我的做法给你，是通过了的。
Private Sub Command4_Click()
On Error Resume Next
Dim strSaveFileName As String
Dim strDefaultName As String
Set ExcelApp = CreateObject("excel.application")
ExcelApp.Workbooks.Add
With adoPrimaryRS1
.MoveFirst
For k = 1 To 15
ExcelApp.Range(ADOEXCE(k) & 1).Value = .Fields(k - 1).Name
Next
l = 2
While Not .EOF
For k = 1 To 15
ExcelApp.Range(ADOEXCE(k) & l).Value = .Fields(k - 1)
Next
l = l + 1
.MoveNext
Wend
ExcelApp.Visible = True
End With
End Sub
在模块中增加子程序
Public Sub ADOEXCEL()
For k = 65 To 90
ADOEXCE(k - 64) = Chr(k)
Next
For k = 91 To 136
ADOEXCE(k - 64) = "A" + Chr(k - 26)
Next
End Sub
在主窗体中增加
ADOEXCEL
