如何用<em>VB</em>从EXCEL中读取和保存数据-vb ado 读取excel,viva

Dim i As Integer
Dim j As Integer
Dim ex As Object
Dim exwbook As Object
Dim exsheet As Object

Set ex = CreateObject("Excel.Application")
Set exwbook = Nothing
Set exsheet = Nothing
Set exwbook = ex.Workbooks().Add

Set exsheet = exwbook.Worksheets("sheet1")

'在excel里表格的表头
ex.Range("c3").Value = "序号1"
ex.Range("d3").Value = "时间"
ex.Range("e3").Value = "数据1"
ex.Range("f3").Value = "数据2"
ex.Range("g3").Value = "数据3"
ex.Range("h3").Value = "累计数据"
'i为记录个数使用循环将数据全部添加7a64e4b893e5b19e336
For i = 1 To Adodc1.Recordset.RecordCount
j = 3 + i
'k为数据列数
For k = 0 To 5
'通过使用变量k和j变换单元格位置
q = Chr(99 + k) & j
'将datagrid1的数据放到单元格内
ex.Range(q).Value = DataGrid1.Columns(k)
Next k
'指针下移
If Adodc1.Recordset.EOF = False Then
Adodc1.Recordset.MoveNext
End If
Next i

'保存输入到信息查询结果.xls
exwbook.SaveAs "D:\新建文件夹\记录.xls"
'退出excel
ex.Quit
End Sub
VB读取EXCEL大致有两种思路（抱歉代码太长手机不方便，有需要可以私信）：
1.数据库方式，一个EXCEL文件就是copy一个数据库，一个SHEET就是一张表，剩下的就是如何操作数据库了，通常引用ADO访问数据。如果不熟悉数据库，请看zhidao第二种。
2.调用EXCEL对象，这需要本机安装EXCEL对象库（一般来说安装了OFFICE就有）并且VB能够引用该对象库。

先来个临时存储，再删除，再添加修改好的。具体代码如下：
'//sql语句导出到excel
'//参数：strSQL－传入的sql语句，strTitle-对应sql语句中每列的标题(例如："编号|名称|规格")
Public Function SQLToExcel(ByVal strSQL As String, ByVal strTitle As String)
Dim rsTemp As ADODB.Recordset
Dim strExcelPath As String '//导出的excel文件路径
Dim arrTemp() As Variant
Dim arrTitle As Variant
Dim lngRows As Long
Dim lngCols As Long
Dim objExcelApp As Object
Dim objExcelWorkBook As Object
Dim objExcelWorkSheet As Object
Dim i As Long
Dim j As Long
On Error GoTo errHandle
If CheckExcel = False Then objInterCont.Tips "请确定已正确安装了Excel软件!": Exit Function
If Trim(strSQL) = "" Then Exit Function
Set rsTemp = mDB.Execute(strSQL)
If rsTemp.BOF And rsTemp.EOF Then
Set rsTemp = Nothing
objInterCont.Tips "没有要导出的数据，请重新选择查询条件!"
Exit Function
End If
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = False
With frmReport.dlgExport '//打开保存对话框
.FileName = ""
.DialogTitle = "请输入Excel文件名称"
.Filter = "Excel Files(*.xls)|*.xls" '//文件类型过虑为excel
.ShowSave
If Trim(.FileName) = "" Then Exit Function
strExcelPath = Trim(.FileName)
If Dir(Trim(.FileName)) <> "" Then '如果存在文件则提示
If MsgBox("文件已存在,是否替换原文件?", vbYesNo + vbQuestion, "提示") = vbYes Then
Kill Trim(.FileName)
Else
objExcelApp.Quit
Set objExcelApp = Nothing
Set rsTemp = Nothing
Exit Function
End If
End If
End With
Screen.MousePointer = 11
DoEvents
Err.Clear
lngRows = rsTemp.RecordCount
lngCols = rsTemp.Fields.Count
ReDim arrTemp(lngRows - 1, lngCols - 1)
i = 0
rsTemp.MoveFirst
Do While Not rsTemp.EOF
For j = 0 To lngCols - 1
arrTemp(i, j) = rsTemp.Fields(j).Value '//保存数据到数组
Next
rsTemp.MoveNext
i = i + 1
Loop
arrTitle = Split(strTitle, "|") '//保存标题到数组
Set objExcelWorkBook = objExcelApp.Workbooks.Add
Set objExcelWorkSheet = objExcelWorkBook.Worksheets(1) '写入第一个工作簿
With objExcelWorkSheet
.Range(.cells(1, 1), .cells(UBound(arrTemp, 1) + 2, UBound(arrTemp, 2) + 1)).NumberFormatLocal = "@"
.Range(.cells(1, 1), .cells(1, UBound(arrTitle, 1) + 1)).Font.Bold = True '//标题加粗
.Range(.cells(1, 1), .cells(1, UBound(arrTitle, 1) + 1)) = arrTitle '写入excel标题
.Range(.cells(2, 1), .cells(UBound(arrTemp, 1) + 2, UBound(arrTemp, 2) + 1)) = arrTemp '写入excel列内容
.cells.EntireColumn.AutoFit '//自动改变列大小
End With
objExcelWorkBook.SaveAs FileName:= _
strExcelPath, FileFormat:= _
1, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
objExcelApp.Quit

Set objExcelApp = Nothing
Set objExcelWorkBook = Nothing
Set objExcelWorkSheet = Nothing
Set rsTemp = Nothing
Erase arrTemp
Erase arrTitle
SQLToExcel = True
Screen.MousePointer = 0
objInterCont.Tips "导出数据成功!"
Exit Function
errHandle:
SQLToExcel = False
Set objExcelApp = Nothing
Set objExcelWorkBook = Nothing
Set objExcelWorkSheet = Nothing
Set rsTemp = Nothing
Erase arrTemp
Erase arrTitle
Screen.MousePointer = 0
If Err.Number = 75 Then
objInterCont.Tips "所覆盖的Excel文件属性只读,导出失e68a84e8a2ade799bee5baa6331败!"
Exit Function
End If
If Err.Number = 70 Then
objInterCont.Tips "所覆盖的Excel文件已打开,导出失败!"
Exit Function
End If
mobjErrLog.Record Err.Number, Err.Description, "DataOperator.cls", "SQLToExcel"
End Function