vb做的excle导出，为什么每次都没有文件保存下来
前面是某位大神给的代码，我想把他改下，加个commondialog控件，添加个文件保存位置和默认名的，但是改了后文件直接没有保存。
程序代码：Public access As New ADODB.Connection
Public res As New ADODB.Recordset
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Private Sub Command1_Click()
Dim str As String
Dim sql As String
str = Text1.Text
res.Close
sql = "SELECT * FROM ziliao where 商品名 like '%" & Text1 & "%' ORDER BY 编号"
res.Open sql, access, 1, 3
Set DataGrid1.DataSource = res
res.Close
End Sub
Private Sub Command2_Click()
Dim Irow, Icol As Integer
Dim Irowcount, Icolcount As Integer
Dim Fieldlen() As Integer
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
sql = "SELECT * FROM ziliao ORDER BY 编号"
res.Open sql, access, 1, 3
Set DataGrid1.DataSource = res
With res
Irowcount = .RecordCount '记录总数
Icolcount = .Fields.Count '字段总数
ReDim Fieldlen(Icolcount) As Integer
res.MoveFirst
For Irow = 1 To Irowcount + 1
For Icol = 1 To Icolcount
Select Case Irow
Case 1 '在Excel中的第一行加标题
xlSheet.Cells(Irow, Icol).Value = RTrim(.Fields(Icol - 1).Name)
Case 2 '将数组FIELDLEN()存为第一条记录的字段长
If IsNull(.Fields(Icol - 1)) = True Then
Fieldlen(Icol) = LenB(RTrim(.Fields(Icol - 1).Name))
Else
aa = RTrim(.Fields(Icol - 1).Name)
Fieldlen(Icol) = LenB(aa)
End If
xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
xlSheet.Cells(Irow, Icol).Value = RTrim(.Fields(Icol - 1))
Case Else
Fieldlen1 = LenB(.Fields(Icol - 1))
If Fieldlen(Icol) < Fieldlen1 Then
xlSheet.Columns(Icol).ColumnWidth = Fieldlen1
Fieldlen(Icol) = Fieldlen1
Else
xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
End If
xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
End Select
Next
If Irow <> 1 Then
If Not .EOF Then .MoveNext
End If
Next
' With xlSheet
' .Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Name = "黑体"
' .Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Bold = True
' .Range(.Cells(1, 1), .Cells(Irow, Icol - 1)).Borders.LineStyle = xlContinuous
' End With
'xlApp.Visible = True
Dim aaa
aaa = MsgBox("是否保存该Excel表?", vbYesNo, "提示窗口")
If aaa = vbYes Then
CommonDialog1.FileName = "报表"
CommonDialog1.Filter = "Xls文件(*.Xls)|*.Xls|所有文件(*.*)|*.*"
CommonDialog1.ShowSave
On Error GoTo ErrSave
NewSheet.SaveAs CommonDialog1.FileName
' MsgBox "保存成功"
newxls.Quit
ErrSave:
Exit Sub
MsgBox Err.Description, , "提示窗口"
End If
Set xlApp = Nothing
End With
End Sub
Private Sub Form_Load()
m = 0
If Dir(App.Path + "\资料.mdb") <> "" Then
access.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\资料.mdb;Persist Security Info=False;Jet OLEDB:Database Password=123"
access.Open
Set res.ActiveConnection = access '设置rs1的ActiveConnection属性，指定与其关联的数据库连接
res.CursorLocation = adUseClient '设置游标类型
res.CursorType = adOpenDynamic '设置动态游标
res.Open "SELECT * FROM ziliao ORDER BY 编号", access, 1, 3 '打开记录集，将从表Departments中读取的结果集保存到记录集res中
DataGrid1.Refresh '刷新表格
Set DataGrid1.DataSource = res '将DataSource连接到数据库
res.MoveFirst
Else
MsgBox "找不到数据库"
End If
res.Close
End Sub
