Generating Excel Files with VB6

Question

I am looking for suggestions on this specific question:

What's the fastest way to generate Excel files (regular XLS, not the XLSX ones) in Visual Basic 6 (VB6)?

Thanks a lot.

Answer 1

最简单的方法是将项目中的引用设置为Excel COM对象，并以编程方式将所有数据插入到工作表中。

Answer 2

Excel has been able to read HTML since Excel 2000.

The easiest way is to write HTML tables and save them with the .xls extension or if it's a web app clear the response buffer, set the response type to "application/vnd.ms-excel" and write out the table with nothing else.

Copy and paste the following into Notepad and save with a .xls extension and open it.

<table>
<tr><th>Color</th><th>Shape</th></tr>
<tr><td>Blue</td><td>Square</td></tr>
</table>

Disclaimer:

I don't recommend this method because it's probably only compatible with Excel but it is the easiest way I know of.

Answer 3

Set a reference (on the Tools menu in VBA, Project in VB6) to the Excel object library (can't remember the exact name, but it'll start with "Microsoft" and have "Excel" somewhere in the name).

Then something like this:

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

Answer 4

The fastest way to create an XLS file is by using Jet's ISAM driver for Excel. Here is a sample how to do it with ADO and 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

Notice the Read Only=0 extended property on the connection string.