2009-08-01 103 views
2

我要找的建議對這個具體問題:生成Excel文件與VB6

什麼是在Visual Basic 6(VB6)來生成Excel文件(XLS定期,而不是那些XLSX),最快的方法?

非常感謝。

+0

最快=?執行速度或編碼時間/努力? – 2009-08-03 07:38:31

回答

3

最簡單的方法是將項目中的引用設置爲Excel COM對象,並以編程方式將所有數據插入到工作表中。

3

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兼容的,但它是我所知道的最簡單的方法。

+0

儘管它確實生成了一個excel電子表格,但它仍然是一個使用excel打開的html表格 – 2009-08-01 17:36:05

+0

@Ori - 但是,如果保存的excel足以將其保存爲原生格式,則這是真實的。我並不是說這是最好的方法,但是在Excel不可用的情況下,它很好地工作。 – MyItchyChin 2009-08-01 17:44:26

2

在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 
1

創建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擴展屬性。