更快导出到Excel

[akilove]

Dim filename As String = SaveFileDialog1.FileName
Dim excelapp As New Microsoft.Office.Interop.Excel.Application
Dim excelbook As Microsoft.Office.Interop.Excel.Workbook = excelapp.Workbooks.Add
Dim excelworksheet As Microsoft.Office.Interop.Excel.Worksheet = CType(excelbook.Worksheets(1), Microsoft.Office.Interop.Excel.Worksheet)
excelapp.Visible = True
With excelworksheet
.Columns().ColumnWidth = 15
.Range("A1").Value = "日期"
.Range("B1").Value = "拉别"
.Range("C1").Value = "单别"
.Range("D1").Value = "分类编号"
Dim i As Integer = 2
Dim dr As DataRow
For Each dr In DsOQA1.Tables("ABC").Rows
.Range("A" & i.ToString).Value = dr("日期")
.Range("B" & i.ToString).Value = dr("拉别")
.Range("C" & i.ToString).Value = dr("单别")
.Range("D" & i.ToString).Value = dr("分类编号")
i += 1
Next
End With
Try
If filename <> "" Then
excelbook.Saved = True
excelbook.SaveCopyAs(filename)

End If
MessageBox.Show("导出文件成功！", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
Catch ex As Exception
MessageBox.Show("导出文件时出错,文件可能正被打开！", "失败", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try




见上述代码,本人做的导出功能,但是是按照一行一行导出,在大量数据面前，显得很慢,不知各位有没有更好的思路导出EXCEL

[kbryant]

进来学习了

[bote_china]

可以使用xslt文件(适用于office2003及更高版本),例如下面的xsl1.xslt

<?xml version="1.0" encoding="UTF8" ?>
<?mso-application progid="Excel.Sheet"?>
<xsl:stylesheet  version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:template match="/">
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"
 xmlns:o="urn:schemas-microsoft-com:office:office"
 xmlns:x="urn:schemas-microsoft-com:office:excel"
 xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"
 xmlns:html="http://www.w3.org/TR/REC-html40">
 <DocumentProperties xmlns="urn:schemas-microsoft-com:office:office">
  <Author>BOTE</Author>
  <LastAuthor>BOTE</LastAuthor>
  <Created>2008-02-26T12:53:11Z</Created>
  <Company>whxg</Company>
  <Version>11.5606</Version>
 </DocumentProperties>
 <ExcelWorkbook xmlns="urn:schemas-microsoft-com:office:excel">
  <WindowHeight>9225</WindowHeight>
  <WindowWidth>11700</WindowWidth>
  <WindowTopX>240</WindowTopX>
  <WindowTopY>105</WindowTopY>
  <ProtectStructure>False</ProtectStructure>
  <ProtectWindows>False</ProtectWindows>
 </ExcelWorkbook>
<Styles>
  <Style ss:ID="Default" ss:Name="Normal">
   <Alignment ss:Vertical="Center"/>
   <Borders/>
   <Font ss:FontName="宋体" x:CharSet="134" ss:Size="12"/>
   <Interior/>
   <NumberFormat/>
   <Protection/>
  </Style>
 </Styles>
 <Worksheet ss:Name="Sheet1">
  <Table ss:ExpandedColumnCount="4" ss:ExpandedRowCount="10000" x:FullColumns="1"
   x:FullRows="1" ss:DefaultColumnWidth="54" ss:DefaultRowHeight="14.25"> 
    <Row>
    <Cell><Data ss:Type="String">日期</Data></Cell>
    <Cell><Data ss:Type="String>拉别</Data></Cell>
    <Cell><Data ss:Type="String">单别</Data></Cell>
    <Cell><Data ss:Type="String">分类编号</Data></Cell>
   </Row>
<xsl:for-each select="descendant::ABC">   
   <Row>
    <Cell><Data ss:Type="String"><xsl:value-of select="日期"/></Data></Cell>
    <Cell><Data ss:Type="Number"><xsl:value-of select="拉别"/></Data></Cell>
    <Cell><Data ss:Type="String"><xsl:value-of select="单别"/></Data></Cell>
    <Cell><Data ss:Type="Number"><xsl:value-of select="分类编号"/></Data></Cell>
   </Row>
</xsl:for-each>
  </Table>
  <WorksheetOptions xmlns="urn:schemas-microsoft-com:office:excel">
   <Selected/>
   <ProtectObjects>False</ProtectObjects>
   <ProtectScenarios>False</ProtectScenarios>
  </WorksheetOptions>
 </Worksheet>
 <Worksheet ss:Name="Sheet2">
  <Table ss:ExpandedColumnCount="0" ss:ExpandedRowCount="0" x:FullColumns="1"
   x:FullRows="1" ss:DefaultColumnWidth="54" ss:DefaultRowHeight="14.25"/>
  <WorksheetOptions xmlns="urn:schemas-microsoft-com:office:excel">
   <ProtectObjects>False</ProtectObjects>
   <ProtectScenarios>False</ProtectScenarios>
  </WorksheetOptions>
 </Worksheet>
 <Worksheet ss:Name="Sheet3">
  <Table ss:ExpandedColumnCount="0" ss:ExpandedRowCount="0" x:FullColumns="1"
   x:FullRows="1" ss:DefaultColumnWidth="54" ss:DefaultRowHeight="14.25"/>
  <WorksheetOptions xmlns="urn:schemas-microsoft-com:office:excel">
   <ProtectObjects>False</ProtectObjects>
   <ProtectScenarios>False</ProtectScenarios>
  </WorksheetOptions>
 </Worksheet>
</Workbook>
</xsl:template>
</xsl:stylesheet>

导出excel时

DsOQA1.WriteXml("XmlData.Xml", XmlWriteMode.IgnoreSchema)
Dim xslTrans As New Xml.Xsl.XslTransform
xslTrans.Load("xsl1.xslt")
xslTrans.Transform("XmlData.Xml", "SavedXlsFile.xls", Nothing)
Call Shell("SavedXlsFile.xls")

[rockyvan]

路過，學習。

[zzy1254]

都差不多,我在博客里有个导出为Excel的函数,你可以看一下,是用DataTable做为源的,将一个DataTable传入就可以了,不过在本机上需要装有Excel才可以,函数支持2003,Excel2000不行,

[herol]

标记一下，以后用到来查

[huangfu_km]

先把数据调入到dataGridView1中,
Dim myexcel As New Excel.Application()
Try
Dim mybook As Excel.Workbook
Dim mysheet As Excel.Worksheet
mysheet = mybook.Worksheets("sheet1")
mysheet.Activate()
mysheet.Range("A1").Select() ---选择粘贴的起始位置

dataGridView1.ClipboardCopyMode =DataGridViewClipboardCopyMode.EnableAlwaysIncludeHeaderText
dataGridView1.SelectAll()
Dim DataObject As New System.Windows.Forms.DataObject
DataObject = dataGridView1.GetClipboardContent()
System.Windows.Forms.Clipboard.SetDataObject(DataObject )
mysheet.PasteSpecial(Format:="文本", Link:=False, DisplayAsIcon:=False)

......
设置单元格的样式
......

Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Information, "错误提示")
Finally
myexcel.Quit()
End Try

[akilove]

vs.2003没有ClipboardCopyMode方法吧?

[于之]

TO: 楼主

Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
Dim strCon As String = "Server=127.0.0.1;Initial Catalog=test;Persist Security Info=True;User ID=sa;Password=2232; "
Dim conn As SqlConnection
conn = New SqlConnection(strcon)
Dim str_cmd As String = "select 100 a11,b11 from TBA "
Dim da As New SqlClient.SqlDataAdapter
da.SelectCommand = New SqlClient.SqlCommand(str_cmd, conn)
Dim mydataset As New DataSet
da.Fill(mydataset, "temp1")
DataGridView1.DataSource = mydataset.Tables(0)
DataGridView1.AutoGenerateColumns = False
DataGridView1.Enabled = True

'---
Dim filename As String = SaveFileDialog1.FileName

Dim excelapp As New Microsoft.Office.Interop.Excel.Application
Dim excelbook As Microsoft.Office.Interop.Excel.Workbook = excelapp.Workbooks.Add
Dim excelworksheet As Microsoft.Office.Interop.Excel.Worksheet = CType(excelbook.Worksheets(1), Microsoft.Office.Interop.Excel.Worksheet)
excelapp.Visible = True
With excelworksheet
.Columns().ColumnWidth = 15
.Range("A1").Value = "a11"
.Range("B1").Value = "b11"
Dim i As Integer = 2
Dim dr As DataRow
For Each dr In mydataset.Tables("0").Rows .Range("A" & i.ToString).Value = dr("a11")
.Range("B" & i.ToString).Value = dr("b11")
i += 1
Next
End With
Try
If filename <> "" Then
excelbook.Saved = True
excelbook.SaveCopyAs(filename)
End If
MessageBox.Show("导出文件成功！", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
Catch ex As Exception
MessageBox.Show("导出文件时出错,文件可能正被打开！", "失败", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try

'---
da.Dispose()
mydataset.Dispose()
conn.Close()
conn.Dispose()

End Sub


楼主我访照你的代码做的,为什么红色那里出错呢? 未将对象引用到对象的实例! 请指点,谢谢!

[leayh]

先撒泡尿，作个记号。