生成Excel文件与VB6
最简单的方法是将项目中的引用设置为Excel COM对象,并以编程方式将所有数据插入到工作表中。
Excel中已经能够读取HTML,因为Excel 2000中
的最简单方法是编写HTML表,并将它们保存扩展名为.xls,或者如果它是一个Web应用程序清除响应缓冲区,设置响应类型为“application/vnd.ms-excel”,并写出表中没有别的。
将以下内容复制并粘贴到记事本中,并以.xls扩展名保存并打开。
<table>
<tr><th>Color</th><th>Shape</th></tr>
<tr><td>Blue</td><td>Square</td></tr>
</table>
免责声明:
我不推荐这种方法,因为它可能只与Excel兼容的,但它是我所知道的最简单的方法。
尽管它确实生成了一个excel电子表格,但它仍然是一个使用excel打开的html表格 – 2009-08-01 17:36:05
@Ori - 但是,如果保存的excel足以将其保存为原生格式,则这是真实的。我并不是说这是最好的方法,但是在Excel不可用的情况下,它很好地工作。 – MyItchyChin 2009-08-01 17:44:26
在Excel对象库中设置一个引用(在VBA的工具菜单中,项目在VB6中)(不记得确切的名称,但它将以“Microsoft”开头并且在“名称)。
然后是这样的:
Public Sub BuildAndSaveWorkbook
With New Excel.Workbook
' do all the stuff to create the content, then'
.SaveAs Filename:="WhateverYouWantToCallIt.xls", FileFormat:=xlExcel8
End With
End Sub
创建XLS文件,最快的方式是使用Jet的ISAM驱动程序用于Excel。下面是一个示例如何使用ADO和ADOX做到这一点:
' References:
' Microsoft ActiveX Data Objects 2.8 Library
' Microsoft ADO Ext. 2.8 for DDL and Security
Option Explicit
Private Sub Command1_Click()
Dim rs As ADODB.Recordset
Set rs = CreateRecordset(_
"ID", adDouble, _
"Name", adVarWChar, 200, _
"Value", adDouble, _
"Memo", adLongVarWChar)
rs.AddNew Array("ID", "Name", "Value", "Memo"), _
Array(1, "test", 5.1, "long long text here")
rs.AddNew Array("ID", "Name", "Value"), _
Array(1, "proba", 15.678)
AppendExcelSheet rs, App.Path & "\test.xls", "My Data", True
AppendExcelSheet rs, App.Path & "\test.xls", "More Data"
End Sub
Private Function CreateRecordset(ParamArray FldDesc()) As ADODB.Recordset
Dim lIdx As Long
Set CreateRecordset = New ADODB.Recordset
With CreateRecordset.Fields
Do While lIdx < UBound(FldDesc)
Select Case FldDesc(lIdx + 1)
Case adDouble, adDate, adCurrency, adBoolean
.Append FldDesc(lIdx), FldDesc(lIdx + 1), , adFldIsNullable
lIdx = lIdx + 2
Case adVarWChar
.Append FldDesc(lIdx), FldDesc(lIdx + 1), FldDesc(lIdx + 2), adFldIsNullable
lIdx = lIdx + 3
Case adLongVarWChar
.Append FldDesc(lIdx), FldDesc(lIdx + 1), -1, adFldIsNullable
lIdx = lIdx + 2
Case Else
Err.Raise vbObjectError, , "Not support Excel data type!"
End Select
Loop
End With
CreateRecordset.Open
End Function
Private Function AppendExcelSheet(_
rsSrc As Recordset, _
sXlsFile As String, _
Optional ByVal sSheetName As String, _
Optional ByVal bCreateNew As Boolean) As Boolean
Dim sConnStr As String
Dim oTbl As ADOX.Table
Dim oCol As ADOX.Column
Dim oFld As ADODB.Field
Dim rsDst As ADODB.Recordset
'--- init local vars
sConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sXlsFile & ";Extended Properties=""Excel 8.0;Read Only=0"""
If LenB(sSheetName) = 0 Then
sSheetName = "Sheet1"
End If
'--- cleanup previous file
If bCreateNew Then
On Error Resume Next
SetAttr sXlsFile, vbArchive
Kill sXlsFile
On Error GoTo 0
End If
'--- create/open workbook and append worksheet
With New ADOX.Catalog
.ActiveConnection = sConnStr
Set oTbl = New ADOX.Table
oTbl.Name = sSheetName
For Each oFld In rsSrc.Fields
Set oCol = New ADOX.Column
With oCol
.Name = oFld.Name
.Type = oFld.Type
End With
oTbl.Columns.Append oCol
Next
.Tables.Append oTbl
End With
'--- copy data to range (named after worksheet)
If rsSrc.RecordCount > 0 Then
Set rsDst = New ADODB.Recordset
rsDst.Open "[" & sSheetName & "]", sConnStr, adOpenDynamic, adLockOptimistic
rsSrc.MoveFirst
Do While Not rsSrc.EOF
rsDst.AddNew
For Each oFld In rsSrc.Fields
rsDst.Fields(oFld.Name).Value = oFld.Value
Next
rsDst.Update
rsSrc.MoveNext
Loop
End If
End Function
通知在连接字符串Read Only=0
扩展属性。
最快=?执行速度或编码时间/努力? – 2009-08-03 07:38:31