189 8069 5689
这里有段VB6.0的，你可以参考。
创新互联-专业网站定制、快速模板网站建设、高性价比涟源网站开发、企业建站全套包干低至880元,成熟完善的模板库,直接使用。一站式涟源网站制作公司更省心,省钱,快速模板网站建设找我们，业务覆盖涟源地区。费用合理售后完善，十年实体公司更值得信赖。
注意添加引用。
Private Sub Command6_Click()
Dim i, j As Integer
Dim xlApplication As Excel.Application, xlWorkbook As Excel.Workbook, xlSheet
Dim xlApp As Excel.Application
On Error Resume Next
Set xlApplication = GetObject(, "Excel.Application")
Set xlApp = CreateObject("Excel.Application")
If MsgBox("确认将文件信息导出到EXCEL中？�", vbExclamation + vbYesNo, "警告") = vbYes Then
If Err.Number 0 Then Set xlApplication = CreateObject("Excel.Application")
Set xlWorkbook = xlApplication.Workbooks.Add
Set xlSheet = xlWorkbook.ActiveSheet
xlSheet.Cells(1, 2) = lblcl.Caption
xlSheet.Range("A1:E1").MergeCells = True
xlSheet.Range("A1:E1").HorizontalAlignment = xlCenter
xlSheet.Cells(2, 2).ColumnWidth = 18
For i = 1 To DataGrid1.Columns.Count
xlSheet.Cells(2, 1) = "编号"
xlSheet.Cells(2, i + 1) = DataGrid1.Columns(i).Caption
For j = 0 To DataGrid1.VisibleRows - 1
xlSheet.Cells(j + 3, 1) = j + 1
xlSheet.Cells(j + 3, i + 1) = DataGrid1.Columns(i).CellText(DataGrid1.RowBookmark(j))
Next j
Next i
xlApplication.Visible = True
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApplication = Nothing
'xlApp.Range("A2:L2").Columns.Interior.ColorIndex = 40
'xlApp.Range("A2:L2").Borders.LineStyle = xlContinuous
'xlApp.Visible = True
'xlApp.Range(xlSheet.Cells(2 + PartsRs.RecordCount + 1, 1), xlSheet.Cells(2 + PartsRs.RecordCount + 1, 8)).Columns.Interior.ColorIndex = 40
'xlApp.Range(xlSheet.Cells(2 + PartsRs.RecordCount + 1, 1), xlSheet.Cells(2 + PartsRs.RecordCount + 1, 8)).Borders.LineStyle = xlContinuous
Else
MsgBox "无信息可供您导出，请确认!", vbExclamation + vbOKOnly, "警告"
End If
End Sub
一、DCOM修复
1.运行：mmc comexp.msc /32，找到我的电脑 - DCom配置中的Microsoft Excel Application
2.在Microsoft Excel Application上点击右键，选择"属性"
3.点击"标识"标签,选择"交互式用户"
4.点击"安全"标签,在"启动和激活权限"上点击"自定义",然后点击对应的"编辑"按钮,在弹出的"安全性"对话框中填加一个"NETWORK SERVICE"用户(注意要选择本计算机名),并给它赋予"本地启动"和"本地激活"权限.
5.依然是"安全"标签,在"访问权限"上点击"自定义",然后点击"编辑",在弹出的"安全性"对话框中也填加一个"NETWORK SERVICE"用户,然后赋予"本地访问"权限.
二、如果找不到Microsoft Excel 应用程序
1、进行OFFICE菜单中的组件重注册
2、如果仍未解决问题，点 开始--运行--输入EXCEL文件所在的路径 “c:\program files\exel.exe” /regserver 进行修复注册
参考：
先在: My Project 中引用 Microsoft Excel 11.0 Object Library（这个是Excel 2003，Excel 2007 是12.0）,之后在窗体代码中加入相关内容就行了。以下是一个窗体的简单实例
假设在C盘根文件夹中有：TEST.xls
Public Class 引用EXCEL窗体
Private A() As String = {"A", "B", "CC", "C", "D"}
Private B() As Integer = {1, 22, 34, 50, 16, 99, 14}
Private excelapp As New Microsoft.Office.Interop.Excel.Application
Private excelworkbook As Microsoft.Office.Interop.Excel.Workbook
Private Sub 引用EXCEL_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim Index As Integer
excelworkbook = excelapp.Workbooks.Open("c:\test.xls")
excelapp.Application.Workbooks.Add(True)
excelapp.Cells(1, 1) = "数组:A"
For Index = 0 To UBound(A)
excelapp.Cells(Index + 2, 1) = A(Index)
Next
excelapp.Cells(1, 2) = "数组:B"
For Index = 0 To UBound(B)
excelapp.Cells(Index + 2, 2) = B(Index)
Next
excelapp.Visible = True
End Sub
End Class
运行结果：
数组:A 数组:B
A 1
B 22
CC 34
C 50
D 16
99
14
以下是我以前百度找的资料 希望对你有用 你读取DataGridView到DataGrid然后直接调用函数即可
Public Function ExportXLsD(ByVal datagrid As DataGrid) ', ByVal Title As String)
'Dim Mytable As New DataTable
'Mytable = CType(datagrid.DataSource, DataTable)
If mytable Is Nothing Then
MessageBox.Show("没有记录不能导出数据", "PurpleStar", MessageBoxButtons.OK, MessageBoxIcon.Information)
Exit Function
End If
If mytable.Rows.Count 0 Then
Dim MyFileName As String
Dim FileName As String
With SaveFileDialog1
.AddExtension = True '如果用户忘记添加扩展名，将自动家上
.DefaultExt = "xls" '默认扩展名
.Filter = "Excel文件(*.xls)|*.xls"
.Title = "文件保存到"
If .ShowDialog = DialogResult.OK Then
FileName = .FileName
End If
End With
MyFileName = Microsoft.VisualBasic.Right(FileName, 4)
If MyFileName = "" Then
Exit Function
End If
If MyFileName = ".xls" Or MyFileName = ".XLS" Then
Dim FS As FileStream = New FileStream(FileName, FileMode.Create)
Dim sw As StreamWriter = New StreamWriter(FS, System.Text.Encoding.Default)
sw.WriteLine(vbTab FileName vbTab Date.Now)
Dim i, j As Integer
Dim str As String = ""
For i = 0 To mytable.Columns.Count - 1
str = mytable.Columns(i).Caption
sw.Write(str vbTab)
Next
sw.Write(vbCrLf)
For j = 0 To mytable.Rows.Count - 1
For i = 0 To mytable.Columns.Count - 1
Dim strColName, strRow As String
strRow = IIf(mytable.Rows(j).Item(i) Is DBNull.Value, "", mytable.Rows(j).Item(i))
sw.Write(strRow vbTab)
Next
sw.Write(vbLf)
Next
sw.Close()
FS.Close()
MessageBox.Show("数据导出成功！", "PurpleStar", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
Exit Function
End If
Else
MessageBox.Show("没有记录不能导出数据", "PurpleStar", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Function
Private Sub OK_Button_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OK_Button.Click
Dim saveExcel As SaveFileDialog
saveExcel = New SaveFileDialog
saveExcel.Filter = "Excel文件(.xls)|*.xls"
Dim filename As String
If saveExcel.ShowDialog = Windows.Forms.DialogResult.Cancel Then Exit Sub
filename = saveExcel.FileName
Dim excel As Excel.Application
excel = New Excel.Application
excel.DisplayAlerts = False
excel.Workbooks.Add(True)
excel.Visible = False
Dim i As Integer
For i = 0 To DataGridView1.Columns.Count - 1
excel.Cells(1, i + 1) = DataGridView1.Columns(i).HeaderText
Next
'设置标题
Dim j As Integer
For i = 0 To DataGridView1.Rows.Count - 1 '填充数据
For j = 0 To DataGridView1.Columns.Count - 1
excel.Cells(i + 2, j + 1) = DataGridView1(j, i).Value
Next
Next
excel.Workbooks(1).SaveCopyAs(filename) '保存
Me.Close()
End Sub