求助：vb保存数据到Excel中，有没有快速的方法！~
如题：
如果用普通的方法速度太慢了，有没有快速的方法将vb中德得到的数据保存到Excel文件中。在读取时我用了打开数据库的方法，速度上没问题，保存有没有类似的方法？我尝试了，但是保存的数据不是A1开始的,而且保存的数据不是数值型的，而是字符型的。望各位大虾不吝赐教！
[解决办法]
Db.Execute "SELECT " & XsZd & " INTO [Excel 8.0;DATABASE= " & CMG.Filename & "].[dcxx] FROM [ " & Bm & "] " & SQLWhere & SQLOrder
XsZd是指要显示的字段
CMG.filename指要保存到的文件名
dcxx是EXCEL中单元表的名称
Bm指数据库的表
sqlwhere指where条件
sqlorder指排序条件
这种方式快！
[解决办法]
sheet1.[d10].copyfromrecordset rst
[解决办法]
偶写过的一个例子供楼主参考，这样的速度很快的！偶大概导出576*20的数据几秒就完事
强烈建议楼主使用导出表格文件比较好的方法是用CSV文件格式
它是一个格式化文本文件，大体格式为：文本行代表表格行
同一行以逗号分隔的内容表示不同字段的内容。
楼主可以将一个普通的EXCEL文件，选择另存为CSV格式后，用写字板打开这个文件看一看格式就知道了，非常简单的。并且这样做速度也很快，完全不是那种一格一格写数据可以比拟的。
在建立数据接口的时候可以建立一个字符串类型的数组，先将所有内容放在数组里，再用循环写入文件里。
几十万条记录的文件处理时间也不过几秒而已
补充一下：你生成的CSV文件，在装有OFFICE的系统上所显示的图标就是一个EXCEL的图标（稍微一点点不同，图标下面多了一个小写的 "a "而已），说明OFFICE已经把这种文件注册为默认可打开的文件类型了。
需要仔细研究，学会并应用！！！！！！！！！！
Rem 快速保存的数据文件格式CSV，可以用EXCEL打开
Private Sub MnuCsv_Click()
Dim i As Integer
'窗体
Dim myPic As StdPicture
Set myPic = CapturePic(Picture1)
SavePicture myPic, "c:\myPic.bmp "
' '写入CSV文件，EXCEL可以打开的文件
Open "D:\11.csv " For Output As #1
Print #1, " 步进序号 "; ", "; ' ' ' ' ' '这里是写CSV的第一行，固定的列头
Print #1, "nx "; ", ";
Print #1, "αi "; ", ";
Print #1, "齿尖转动半径 "; ", ";
Print #1, "Fc "; ", ";
Print #1, "Fh "; ", ";
Print #1, "Fdt "; ", ";
Print #1, "Fdn "; ", ";
Print #1, "Fo "; ", ";
Print #1, vbNullString ' ' ' '结束换行
' ' ' ' ' '写入数据
For i = 1 To 546
Print #1, Val(MSFlexGrid1.TextMatrix(i, 0)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 1)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 2)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 3)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 4)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 5)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 6)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 7)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 8)); ", ";
Print #1, vbNullString
Next
Close #1
End Sub
打开保存文件方式：：
Rem 快速保存的数据文件格式CSV，可以用EXCEL打开
Private Sub MnuCsv_Click()
Dim i As Integer
'窗体
Dim myPic As StdPicture
Set myPic = CapturePic(Picture1)
SavePicture myPic, "c:\myPic.bmp "
' '写入CSV文件，EXCEL可以打开的文件
Dim FileName As String ' ' ' ' ' ' ' ' ' ' '将数据保存到Excel表里
CommDiag1.FileName = " "
CommDiag1.Filter = "CSV|*.csv "
CommDiag1.ShowSave
FileName = CommDiag1.FileName
If FileName = " " Then
Exit Sub
End If
Open FileName For Output As #1
Print #1, " 步进序号 "; ", "; ' ' ' ' ' '这里是写CSV的第一行，固定的列头
Print #1, "nx "; ", ";
Print #1, "αi "; ", ";
Print #1, "齿尖转动半径 "; ", ";
Print #1, "Fc "; ", ";
Print #1, "Fh "; ", ";
Print #1, "Fdt "; ", ";
Print #1, "Fdn "; ", ";
Print #1, "Fo "; ", ";
Print #1, vbNullString ' ' ' '结束换行
' ' ' ' ' '写入数据
For i = 1 To 546
Print #1, Val(MSFlexGrid1.TextMatrix(i, 0)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 1)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 2)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 3)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 4)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 5)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 6)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 7)); ", ";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 8)); ", ";
Print #1, vbNullString
Next
Close #1
End Sub
[解决办法]
Private Sub Cmd_export_Click()
Dim strSql As String
Dim keycode As String
On Error GoTo err
If Trim(Cbo_date1.Text) = " " Or Trim(Cbo_date2.Text) = " " Then
MsgBox "请您选择导出的具体的结算日期! ", vbOKOnly + vbExclamation, "警告 "
Cbo_date1.SetFocus
End If
keycode = Trim(Cbo_date1.Text) & lpad(Trim(Cbo_date2.Text), 2, "0 ")
strSql = "SELECT * FROM t_monthtotal where total_no = ' " & Trim(keycode) & " ' "
ExportExcel (strSql)
fin: Exit Sub
err:
MsgBox "存在错误，请检查数据或是检查程序 ", vbOKOnly + vbExclamation, "警告 "
Resume err
End Sub
' ' '---引用 Microsoft Excel 11.0 Object Library
Public Function ExportExcel(ByVal strSql As String)
On Error GoTo err
' 定義 Excel 對象
Dim priXLS As Excel.Application
Dim priWorkbook As Excel.Workbook
Dim priSheet As Excel.Worksheet
' Rs 臨時記錄集
Dim Rs As New ADODB.Recordset
Dim lngRow As Long, lngRows As Long, intField As Integer, intFields As Integer
Screen.MousePointer = vbHourglass
' 打開記錄集﹐得到數據﹐將數據導入 Excel 表中
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection
cnn.Provider = "SQLOLEDB "
cnn.Open ConnectString
If Rs.State Then Rs.Close
Rs.Open strSql, cnn, adOpenKeyset, adLockOptimistic
If Rs.RecordCount = 0 Then GoTo err
Set priXLS = New Excel.Application
Set priWorkbook = priXLS.Workbooks.Add
Set priSheet = priXLS.Sheets(1)
With priSheet
intFields = Rs.Fields.Count
' ' '給字段標頭
For intField = 1 To intFields
.Cells(1, intField) = " ' " & Rs(intField - 1).Name
Next
Rs.MoveLast
lngCount = Rs.RecordCount
Rs.MoveFirst
' ' '給字段的值
For lngID = 1 To lngCount
For intField = 1 To intFields
.Cells(lngID + 1, intField) = " ' " & Rs(intField - 1).Value
Next
Rs.MoveNext
Next
End With
priXLS.Visible = True
err:
Screen.MousePointer = 0
End Function
